BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
;;4.0;BMX;;JUN 28, 2010
;
;
WINVAL(BMXRET,BMXWINID) ;EP
;Validates user based on Windows Identity
;
;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason)
; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n)
; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
I $$NEWERR^%ZTER N $ETRAP S $ETRAP="" ; IHS/OIT/HMW SAC Exemption Applied For
N X,BMXUSER,BMXUNOW,BMXUM,BMXUMSG,BMXVCOK
S %="DUZ" K @%
S BMXRET(0)=0,BMXRET(5)=0,BMXUM=0,BMXUMSG=0
S DUZ=0,DUZ(0)="",BMXVCOK=0 D NOW ;IHS/OIT/HMW SAC Exemption Applied For
S BMXUMSG=$$INHIBIT() I BMXUMSG S BMXUM=1 G VAX ;Logon inhibited
;
S DUZ=$$WINUGET^BMXRPC3(BMXWINID) ;IHS/OIT/HMW SAC Exemption Applied For
I DUZ>0 D USER(DUZ)
S BMXUMSG=$$UVALID() G:BMXUMSG VAX
I DUZ>0 S BMXUMSG=$$POST(1)
VAX S:BMXUMSG>0 DUZ=0 D:DUZ>0 POST2
S BMXRET(0)=DUZ,BMXRET(1)=BMXUM,BMXRET(2)=BMXVCOK,BMXRET(3)=$S(BMXUMSG:$$TXT(BMXUMSG),1:""),BMXRET(4)=0
Q
;
NOW S U="^",BMXUNOW=$$NOW^XLFDT(),DT=$P(BMXUNOW,".")
Q
;
USER(IX) ;Build USER
S BMXUSER(0)=$G(^VA(200,+IX,0)),BMXUSER(1)=$G(^(.1))
Q
;
POST(CVC) ;Finish setup partition, I CVC don't log get
N X,BMXUM
K ^UTILITY($J),^TMP($J)
I '$D(USER(0)),DUZ D USER(DUZ)
S BMXUM=$$USER1A Q:BMXUM>0 BMXUM ;User can't sign on for some reason.
S BMXRET(5)=0 ;The next line sends the post sign-on msg
F BMXPT=1:1 Q:'$D(BMXUTEXT(BMXPT)) S BMXRET(5+BMXPT)=$E(BMXUTEXT(BMXPT),2,256),BMXRET(5)=BMXPT
S BMXRET(5)=0 ;This line stops the display of the msg. Remove this line to allow.
D:'$G(CVC) POST2
Q 0
POST2 D:'$D(BMXUNOW) NOW
D DUZ ;^XUS1A ;,SAVE^XUS1,LOG^XUS1,ABT^XQ12
K BMXUTEXT,BMXOPT,BMXUER ;XUEON,XUEOFF,XUTT
Q
;
DUZ ;Setup DUZ. SAC exemption applied for.
S:'$D(BMXUSER(0)) BMXUSER(0)=^VA(200,DUZ,0) D:$D(BMXOPT)[0 BMXOPT
S DUZ(0)=$P(BMXUSER(0),U,4),DUZ(1)="",DUZ("AUTO")=$P(BMXOPT,"^",6) ;IHS/OIT/HMW SAC Exemption Applied For
S DUZ(2)=$S($G(DUZ(2))>0:DUZ(2),1:+$P(BMXOPT,U,17)) ;IHS/OIT/HMW SAC Exemption Applied For
S X=$P($G(^DIC(4,DUZ(2),99)),U,5),DUZ("AG")=$S(X]"":X,1:$P(^XTV(8989.3,1,0),U,8))
S DUZ("BUF")=($P(BMXOPT,U,9)="Y"),DUZ("LANG")=$P(BMXOPT,U,7) ;IHS/OIT/HMW SAC Exemption Applied For
Q
;
USER1A() ;
N BMXPTB,BMXPTE,BMXPTT
S BMXUTEXT=0,DUZ(2)=0
F I=0:0 S I=$O(^XTV(8989.3,1,"POST",I)) Q:I'>0 D SET("!"_$G(^(I,0)))
D SET("!"),BMXOPT
S BMXPTH=$P($H,",",2)
D SET("!Good "_$S(BMXPTH<43200:"morning ",BMXPTH<61200:"afternoon ",1:"evening ")_$S($P(BMXUSER(1),U,4)]"":$P(BMXUSER(1),U,4),1:$P(BMXUSER(0),U,1)))
S BMXI1=$G(^VA(200,DUZ,1.1)),X=(+BMXI1_"0000")
I X D SET("! You last signed on "_$S(X\1=DT:"today",X\1+1=DT:"yesterday",1:$$DD(X))_" at "_$E(X,9,10)_":"_$E(X,11,12))
I $P(BMXI1,"^",2) S I=$P(BMXI1,"^",2) D SET("!There "_$S(I>1:"were ",1:"was ")_I_" unsuccessful attempt"_$S(I>1:"s",1:"")_" since you last signed on.")
I $P(BMXUSER(0),U,12),$$PROHIBIT(BMXPTH,$P(BMXUSER(0),U,12)) Q 17 ;Time frame
I +$P(BMXOPT,U,15) S BMXPT=$P(BMXOPT,U,15)-($H-BMXUSER(1)) I BMXPT<6,BMXPT>0 D SET("! Your Verify code will expire in "_BMXPT_" days")
S:$P(BMXOPT,"^",5) XUTT=1 S:'$D(DTIME) DTIME=$P(BMXOPT,U,10) ; IHS/OIT/HMW SAC Exemption Applied For
I ('X)!$P(BMXOPT,U,4) Q 0
Q 9
;
BMXOPT ;Build the BMXOPT string
N X,I
S:'$D(BMXOPT) BMXOPT=$G(^XTV(8989.3,1,"XUS"))
S X=$G(^VA(200,DUZ,200))
F I=4:1:7,9,10 I $P(X,U,I)]"" S $P(BMXOPT,"^",I)=$P(X,U,I)
Q
;
SET(V) ;Set into BMXUTEXT(BMXUTEXT)
S BMXUTEXT=$G(BMXUTEXT)+1,BMXUTEXT(BMXUTEXT)=V
Q
;
PROHIBIT(BMXPTT,BMXPTR) ;See if a prohibited time, (Current time, restrict range)
N XMSG,BMXPTB,BMXPTE
S BMXPTT=BMXPTT\60#60+(BMXPTT\3600*100),BMXPTB=$P(BMXPTR,"-",1),BMXPTE=$P(BMXPTR,"-",2)
S XMSG=$P($$FMTE^XLFDT(DT_"."_BMXPTB,"2P")," ",2,3)_" thru "_$P($$FMTE^XLFDT(DT_"."_BMXPTE,"2P")," ",2,3)
I $S(BMXPTE'<BMXPTB:BMXPTT'>BMXPTE&(BMXPTT'<BMXPTB),1:BMXPTT>BMXPTB!(BMXPTT<BMXPTE)) S BMXUM(0)=XMSG Q 1 ;No
D SET("!")
D SET("! Your access is restricted during this time frame "_XMSG)
Q 0
;
INHIBIT() ;Is Logon to this system Inhibited?
N BMXENV,BMXCI,BMXQVOL,BMXVOL
D GETENV^%ZOSV S U="^",BMXENV=Y,BMXCI=$P(Y,U,1),BMXQVOL=$P(Y,U,2)
S X=$O(^XTV(8989.3,1,4,"B",BMXQVOL,0)),BMXVOL=$S(X>0:^XTV(8989.3,1,4,X,0),1:BMXQVOL_"^y^1") S:$P(BMXVOL,U,6)="y" XRTL=BMXCI_","_BMXQVOL
;I '$D(BMXQVOL) Q 0
;I '$D(BMXVOL) Q 0
I $G(^%ZIS(14.5,"LOGON",BMXQVOL)) Q 1
I $D(^%ZOSF("ACTJ")) X ^("ACTJ") I $P(BMXVOL,U,3),($P(BMXVOL,U,3)'>Y) Q 2
Q 0
;
;
UVALID() ;EF. Is it valid for this user to sign on?
I '+$G(BMXWIN) Q 18
I DUZ'>0 Q 4
I $P(BMXUSER(0),U,11),$P(BMXUSER(0),U,11)'>DT Q 11 ;Access Terminated
I $P(BMXUSER(0),U,7) Q 5 ;Disuser flag set
Q 0
;
DD(Y) Q $S($E(Y,4,5):$P("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$E(Y,4,5))_" ",1:"")_$S($E(Y,6,7):+$E(Y,6,7)_",",1:"")_($E(Y,1,3)+1700)
Q
;
TXT(BMXPT) ;
S BMXPT=$T(ZZ+BMXPT)
S BMXPT=$P(BMXPT,";",4,9) I BMXPT["|" S BMXPT=$P(BMXPT,"|",1)_$G(BMXUM(0))_$P(BMXPT,"|",2)
Q BMXPT
ZZ ;;Halt;Error Messages
1 ;;1;Signons not currently allowed on this processor.
2 ;;1;Maximum number of users already signed on to this processor.
3 ;;1;This device has not been defined to the system -- contact system manager.
4 ;;0;Not a valid Windows Identity map value.
5 ;;0;No Access Allowed for this User.
6 ;;0;Invalid device password.
7 ;;0;Device locked due to too many invalid sign-on attempts.
8 ;;1;This device is out of service.
9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***
10 ;;1;You don't have access to this device!
11 ;;0;Your access code has been terminated. Please see your site manager!
12 ;;0;VERIFY CODE MUST be changed before continued use.
13 ;;1;This device may only be used outside of this time frame |
14 ;;0;'|' is not a valid UCI!
15 ;;0;'|' is not a valid program name!
16 ;;0;No PRIMARY MENU assigned to user or User is missing KEY to menu!
17 ;;0;Your access to the system is prohibited from |.
18 ;;0;Windows Integrated Security Not Allowed on this port.
BMXRPC7 ; IHS/OIT/HMW - BMX REMOTE PROCEDURE CALLS ;
+1 ;;4.0;BMX;;JUN 28, 2010
+2 ;
+3 ;
WINVAL(BMXRET,BMXWINID) ;EP
+1 ;Validates user based on Windows Identity
+2 ;
+3 ;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason)
+4 ; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n)
+5 ; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
+6 ; IHS/OIT/HMW SAC Exemption Applied For
IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+7 NEW X,BMXUSER,BMXUNOW,BMXUM,BMXUMSG,BMXVCOK
+8 SET %="DUZ"
KILL @%
+9 SET BMXRET(0)=0
SET BMXRET(5)=0
SET BMXUM=0
SET BMXUMSG=0
+10 ;IHS/OIT/HMW SAC Exemption Applied For
SET DUZ=0
SET DUZ(0)=""
SET BMXVCOK=0
DO NOW
+11 ;Logon inhibited
SET BMXUMSG=$$INHIBIT()
IF BMXUMSG
SET BMXUM=1
GOTO VAX
+12 ;
+13 ;IHS/OIT/HMW SAC Exemption Applied For
SET DUZ=$$WINUGET^BMXRPC3(BMXWINID)
+14 IF DUZ>0
DO USER(DUZ)
+15 SET BMXUMSG=$$UVALID()
IF BMXUMSG
GOTO VAX
+16 IF DUZ>0
SET BMXUMSG=$$POST(1)
VAX IF BMXUMSG>0
SET DUZ=0
IF DUZ>0
DO POST2
+1 SET BMXRET(0)=DUZ
SET BMXRET(1)=BMXUM
SET BMXRET(2)=BMXVCOK
SET BMXRET(3)=$SELECT(BMXUMSG:$$TXT(BMXUMSG),1:"")
SET BMXRET(4)=0
+2 QUIT
+3 ;
NOW SET U="^"
SET BMXUNOW=$$NOW^XLFDT()
SET DT=$PIECE(BMXUNOW,".")
+1 QUIT
+2 ;
USER(IX) ;Build USER
+1 SET BMXUSER(0)=$GET(^VA(200,+IX,0))
SET BMXUSER(1)=$GET(^(.1))
+2 QUIT
+3 ;
POST(CVC) ;Finish setup partition, I CVC don't log get
+1 NEW X,BMXUM
+2 KILL ^UTILITY($JOB),^TMP($JOB)
+3 IF '$DATA(USER(0))
IF DUZ
DO USER(DUZ)
+4 ;User can't sign on for some reason.
SET BMXUM=$$USER1A
IF BMXUM>0
QUIT BMXUM
+5 ;The next line sends the post sign-on msg
SET BMXRET(5)=0
+6 FOR BMXPT=1:1
IF '$DATA(BMXUTEXT(BMXPT))
QUIT
SET BMXRET(5+BMXPT)=$EXTRACT(BMXUTEXT(BMXPT),2,256)
SET BMXRET(5)=BMXPT
+7 ;This line stops the display of the msg. Remove this line to allow.
SET BMXRET(5)=0
+8 IF '$GET(CVC)
DO POST2
+9 QUIT 0
POST2 IF '$DATA(BMXUNOW)
DO NOW
+1 ;^XUS1A ;,SAVE^XUS1,LOG^XUS1,ABT^XQ12
DO DUZ
+2 ;XUEON,XUEOFF,XUTT
KILL BMXUTEXT,BMXOPT,BMXUER
+3 QUIT
+4 ;
DUZ ;Setup DUZ. SAC exemption applied for.
+1 IF '$DATA(BMXUSER(0))
SET BMXUSER(0)=^VA(200,DUZ,0)
IF $DATA(BMXOPT)[0
DO BMXOPT
+2 ;IHS/OIT/HMW SAC Exemption Applied For
SET DUZ(0)=$PIECE(BMXUSER(0),U,4)
SET DUZ(1)=""
SET DUZ("AUTO")=$PIECE(BMXOPT,"^",6)
+3 ;IHS/OIT/HMW SAC Exemption Applied For
SET DUZ(2)=$SELECT($GET(DUZ(2))>0:DUZ(2),1:+$PIECE(BMXOPT,U,17))
+4 SET X=$PIECE($GET(^DIC(4,DUZ(2),99)),U,5)
SET DUZ("AG")=$SELECT(X]"":X,1:$PIECE(^XTV(8989.3,1,0),U,8))
+5 ;IHS/OIT/HMW SAC Exemption Applied For
SET DUZ("BUF")=($PIECE(BMXOPT,U,9)="Y")
SET DUZ("LANG")=$PIECE(BMXOPT,U,7)
+6 QUIT
+7 ;
USER1A() ;
+1 NEW BMXPTB,BMXPTE,BMXPTT
+2 SET BMXUTEXT=0
SET DUZ(2)=0
+3 FOR I=0:0
SET I=$ORDER(^XTV(8989.3,1,"POST",I))
IF I'>0
QUIT
DO SET("!"_$GET(^(I,0)))
+4 DO SET("!")
DO BMXOPT
+5 SET BMXPTH=$PIECE($HOROLOG,",",2)
+6 DO SET("!Good "_$SELECT(BMXPTH<43200:"morning ",BMXPTH<61200:"afternoon ",1:"evening ")_$SELECT($PIECE(BMXUSER(1),U,4)]"":$PIECE(BMXUSER(1),U,4),1:$PIECE(BMXUSER(0),U,1)))
+7 SET BMXI1=$GET(^VA(200,DUZ,1.1))
SET X=(+BMXI1_"0000")
+8 IF X
DO SET("! You last signed on "_$SELECT(X\1=DT:"today",X\1+1=DT:"yesterday",1:$$DD(X))_" at "_$EXTRACT(X,9,10)_":"_$EXTRACT(X,11,12))
+9 IF $PIECE(BMXI1,"^",2)
SET I=$PIECE(BMXI1,"^",2)
DO SET("!There "_$SELECT(I>1:"were ",1:"was ")_I_" unsuccessful attempt"_$SELECT(I>1:"s",1:"")_" since you last signed on.")
+10 ;Time frame
IF $PIECE(BMXUSER(0),U,12)
IF $$PROHIBIT(BMXPTH,$PIECE(BMXUSER(0),U,12))
QUIT 17
+11 IF +$PIECE(BMXOPT,U,15)
SET BMXPT=$PIECE(BMXOPT,U,15)-($HOROLOG-BMXUSER(1))
IF BMXPT<6
IF BMXPT>0
DO SET("! Your Verify code will expire in "_BMXPT_" days")
+12 ; IHS/OIT/HMW SAC Exemption Applied For
IF $PIECE(BMXOPT,"^",5)
SET XUTT=1
IF '$DATA(DTIME)
SET DTIME=$PIECE(BMXOPT,U,10)
+13 IF ('X)!$PIECE(BMXOPT,U,4)
QUIT 0
+14 QUIT 9
+15 ;
BMXOPT ;Build the BMXOPT string
+1 NEW X,I
+2 IF '$DATA(BMXOPT)
SET BMXOPT=$GET(^XTV(8989.3,1,"XUS"))
+3 SET X=$GET(^VA(200,DUZ,200))
+4 FOR I=4:1:7,9,10
IF $PIECE(X,U,I)]""
SET $PIECE(BMXOPT,"^",I)=$PIECE(X,U,I)
+5 QUIT
+6 ;
SET(V) ;Set into BMXUTEXT(BMXUTEXT)
+1 SET BMXUTEXT=$GET(BMXUTEXT)+1
SET BMXUTEXT(BMXUTEXT)=V
+2 QUIT
+3 ;
PROHIBIT(BMXPTT,BMXPTR) ;See if a prohibited time, (Current time, restrict range)
+1 NEW XMSG,BMXPTB,BMXPTE
+2 SET BMXPTT=BMXPTT\60#60+(BMXPTT\3600*100)
SET BMXPTB=$PIECE(BMXPTR,"-",1)
SET BMXPTE=$PIECE(BMXPTR,"-",2)
+3 SET XMSG=$PIECE($$FMTE^XLFDT(DT_"."_BMXPTB,"2P")," ",2,3)_" thru "_$PIECE($$FMTE^XLFDT(DT_"."_BMXPTE,"2P")," ",2,3)
+4 ;No
IF $SELECT(BMXPTE'<BMXPTB:BMXPTT'>BMXPTE&(BMXPTT'<BMXPTB),1:BMXPTT>BMXPTB!(BMXPTT<BMXPTE))
SET BMXUM(0)=XMSG
QUIT 1
+5 DO SET("!")
+6 DO SET("! Your access is restricted during this time frame "_XMSG)
+7 QUIT 0
+8 ;
INHIBIT() ;Is Logon to this system Inhibited?
+1 NEW BMXENV,BMXCI,BMXQVOL,BMXVOL
+2 DO GETENV^%ZOSV
SET U="^"
SET BMXENV=Y
SET BMXCI=$PIECE(Y,U,1)
SET BMXQVOL=$PIECE(Y,U,2)
+3 SET X=$ORDER(^XTV(8989.3,1,4,"B",BMXQVOL,0))
SET BMXVOL=$SELECT(X>0:^XTV(8989.3,1,4,X,0),1:BMXQVOL_"^y^1")
IF $PIECE(BMXVOL,U,6)="y"
SET XRTL=BMXCI_","_BMXQVOL
+4 ;I '$D(BMXQVOL) Q 0
+5 ;I '$D(BMXVOL) Q 0
+6 IF $GET(^%ZIS(14.5,"LOGON",BMXQVOL))
QUIT 1
+7 IF $DATA(^%ZOSF("ACTJ"))
XECUTE ^("ACTJ")
IF $PIECE(BMXVOL,U,3)
IF ($PIECE(BMXVOL,U,3)'>Y)
QUIT 2
+8 QUIT 0
+9 ;
+10 ;
UVALID() ;EF. Is it valid for this user to sign on?
+1 IF '+$GET(BMXWIN)
QUIT 18
+2 IF DUZ'>0
QUIT 4
+3 ;Access Terminated
IF $PIECE(BMXUSER(0),U,11)
IF $PIECE(BMXUSER(0),U,11)'>DT
QUIT 11
+4 ;Disuser flag set
IF $PIECE(BMXUSER(0),U,7)
QUIT 5
+5 QUIT 0
+6 ;
DD(Y) QUIT $SELECT($EXTRACT(Y,4,5):$PIECE("Jan^Feb^Mar^Apr^May^Jun^Jul^Aug^Sep^Oct^Nov^Dec","^",+$EXTRACT(Y,4,5))_" ",1:"")_$SELECT($EXTRACT(Y,6,7):+$EXTRACT(Y,6,7)_",",1:"")_($EXTRACT(Y,1,3)+1700)
+1 QUIT
+2 ;
TXT(BMXPT) ;
+1 SET BMXPT=$TEXT(ZZ+BMXPT)
+2 SET BMXPT=$PIECE(BMXPT,";",4,9)
IF BMXPT["|"
SET BMXPT=$PIECE(BMXPT,"|",1)_$GET(BMXUM(0))_$PIECE(BMXPT,"|",2)
+3 QUIT BMXPT
ZZ ;;Halt;Error Messages
1 ;;1;Signons not currently allowed on this processor.
2 ;;1;Maximum number of users already signed on to this processor.
3 ;;1;This device has not been defined to the system -- contact system manager.
4 ;;0;Not a valid Windows Identity map value.
5 ;;0;No Access Allowed for this User.
6 ;;0;Invalid device password.
7 ;;0;Device locked due to too many invalid sign-on attempts.
8 ;;1;This device is out of service.
9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***
10 ;;1;You don't have access to this device!
11 ;;0;Your access code has been terminated. Please see your site manager!
12 ;;0;VERIFY CODE MUST be changed before continued use.
13 ;;1;This device may only be used outside of this time frame |
14 ;;0;'|' is not a valid UCI!
15 ;;0;'|' is not a valid program name!
16 ;;0;No PRIMARY MENU assigned to user or User is missing KEY to menu!
17 ;;0;Your access to the system is prohibited from |.
18 ;;0;Windows Integrated Security Not Allowed on this port.
