| 1 | XUSRB5 ;SFISC/STAFF - FATKAT and KAJEE support ;09/08/2005
|
|---|
| 2 | ;;8.0;KERNEL;**361**;Jul 10, 1995;Build 1
|
|---|
| 3 | Q
|
|---|
| 4 | ;All this code is run under an APPLICATION PROXY user.
|
|---|
| 5 | FATKAAT1(RET,AVCODE,CLIENTIP) ;Get division list via proxy
|
|---|
| 6 | ;Use AVcode to find user, Return data from VALIDAV plus DIVGET
|
|---|
| 7 | N DUZ ;Protect caller
|
|---|
| 8 | N %,X,CCOW,IEN,XUCI,XQVOL,XUVOL,XUTEXT,DIV
|
|---|
| 9 | S CLIENTIP=$G(CLIENTIP,$G(IO("IP"))) S:'$L(CLIENTIP) CLIENTIP="127.0.0.1" ;Use loopback if don't have real one.
|
|---|
| 10 | D XUVOL^XUS
|
|---|
| 11 | D VALIDAV(AVCODE,.DIV,CLIENTIP) ;DIVGET is done in here
|
|---|
| 12 | S %=RET(5)+6,CCOW=$D(DUZ("CCOW"))
|
|---|
| 13 | Q:'RET(0)
|
|---|
| 14 | I CCOW D Q
|
|---|
| 15 | . S RET(%+1)=1,RET(%+2)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))_"^1"
|
|---|
| 16 | . Q
|
|---|
| 17 | I 'CCOW F X=0:1:DIV D
|
|---|
| 18 | . S RET(%+X)=DIV(X)
|
|---|
| 19 | K DUZ("CCOW")
|
|---|
| 20 | Q
|
|---|
| 21 | ;
|
|---|
| 22 | DIVGET(XUDIV,IEN) ;Get Division data
|
|---|
| 23 | N %,X
|
|---|
| 24 | S XUDIV=0,%=$$CHKDIV^XUS1(.XUDIV) ;Get users div.
|
|---|
| 25 | I 'XUDIV,(%>0)&($P(%,U,2)'>0) D
|
|---|
| 26 | . S DUZ(2)=+% ;Set users default div.
|
|---|
| 27 | . S XUDIV=1,XUDIV(1)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))_"^1"
|
|---|
| 28 | I 'XUDIV,'% D
|
|---|
| 29 | . S DUZ(2)=+$$KSP^XUPARAM("INST")
|
|---|
| 30 | . S XUDIV=1,XUDIV(1)=DUZ(2)_"^"_$$NS^XUAF4(DUZ(2))_"^1"
|
|---|
| 31 | ;
|
|---|
| 32 | S %=0 D S RESULT(0)=XUDIV
|
|---|
| 33 | . ;RET(%) is divison array eg. ien;station name;station#
|
|---|
| 34 | . F S %=$O(XUDIV(%)) Q:(%'>0) D
|
|---|
| 35 | .. S XUDIV(%)=$P(XUDIV(%),U,1,3)_U_(+$P(XUDIV(%),U,4))
|
|---|
| 36 | S XUDIV(0)=XUDIV
|
|---|
| 37 | Q
|
|---|
| 38 | ;
|
|---|
| 39 | VALIDAV(AVCODE,DIV,CLIP) ;Check a users access
|
|---|
| 40 | ;Return R(0)=DUZ, R(1)=(0=OK, 1,2...=Can't sign-on for some reason)
|
|---|
| 41 | ; R(2)=verify needs changing, R(3)=Message, R(4)=0, R(5)=msg cnt, R(5+n)
|
|---|
| 42 | ; R(R(5)+6)=# div user must select from, R(R(5)+6+n)=div
|
|---|
| 43 | ;
|
|---|
| 44 | N X,XUSER,XUF,XUNOW,XUDEV,XUM,XUMSG,%1,VCCH
|
|---|
| 45 | S U="^",RET(0)=0,RET(1)=0,RET(2)=0,RET(3)="",RET(4)=0,RET(5)=0
|
|---|
| 46 | S XUF=$G(XUF,0),XUM=0,XUMSG=0,XUDEV=0
|
|---|
| 47 | S DUZ=0,DUZ(0)="",VCCH=0 D NOW
|
|---|
| 48 | D XOPT^XUS
|
|---|
| 49 | S XUMSG=$$INHIBIT^XUSRB() I XUMSG S XUM=1 G VAX ;Logon inhibited
|
|---|
| 50 | ;3 Strikes, Put J2EE server IP in as Terminal server.
|
|---|
| 51 | I $$LKCHECK^XUSTZIP($G(CLIP)) S XUMSG=7 G VAX ;IP locked
|
|---|
| 52 | ;Only allow A/V, CCOW sign-on code
|
|---|
| 53 | I $L(AVCODE) S DUZ=$$CHECKAV^XUS($$DECRYP^XUSRB1(AVCODE))
|
|---|
| 54 | D DIVGET(.DIV) ;Get DIV now
|
|---|
| 55 | I DUZ'>0 S XUM=1,XUMSG=4 D H 2 G VAX ;Bad AV code
|
|---|
| 56 | . S X=$$FAIL^XUS3(CLIP) ;Check Lockout
|
|---|
| 57 | S XUMSG=$$UVALID^XUS() G:XUMSG VAX ;Check User
|
|---|
| 58 | S VCCH=$$VCVALID^XUSRB() ;Check VC
|
|---|
| 59 | I DUZ>0 S XUMSG=$$POST(1)
|
|---|
| 60 | I XUMSG>0 S DUZ=0,VCCH=0 ;If can't sign-on, don't tell need to change VC
|
|---|
| 61 | I 'XUMSG,VCCH S XUMSG=12 ;Need to change VC
|
|---|
| 62 | VAX S:XUMSG>0 DUZ=0 ;Can't sign-on, Clear DUZ.
|
|---|
| 63 | S RET(0)=DUZ,RET(1)=XUM,RET(2)=VCCH,RET(3)=$S(XUMSG:$$TXT^XUS3(XUMSG),1:""),RET(4)=0
|
|---|
| 64 | Q
|
|---|
| 65 | ;
|
|---|
| 66 | CVC(RET,XU1) ;change VC, Return 0 = success
|
|---|
| 67 | N XU2,XU3,XU4 S DUZ=$G(DUZ),RET(0)=99,XU4=$$STATE^XWBSEC("XUS DUZ") S:(DUZ=0)&(XU4>0) DUZ=XU4 Q:DUZ'>0
|
|---|
| 68 | S U="^",XU2=$P(XU1,U,2),XU3=$P(XU1,U,3),XU1=$P(XU1,U)
|
|---|
| 69 | S XU1=$$DECRYP^XUSRB1(XU1),XU2=$$DECRYP^XUSRB1(XU2),XU3=$$DECRYP^XUSRB1(XU3)
|
|---|
| 70 | S XU3=$$BRCVC^XUS2(XU1,XU2),RET(0)=+XU3,RET(1)=$P(XU3,U,2,9)
|
|---|
| 71 | I XU3>0 S DUZ=0 ;Clean-up if not changed.
|
|---|
| 72 | I 'XU3,XU4 D KILL^XWBSEC("XUS DUZ"),POST2
|
|---|
| 73 | Q
|
|---|
| 74 | ;
|
|---|
| 75 | POST(CVC) ;Finish setup partition, I CVC don't log yet
|
|---|
| 76 | N X,XUM,XUDIV
|
|---|
| 77 | I '$D(XUSER(0)),DUZ D USER^XUS(DUZ)
|
|---|
| 78 | S XUM=$$USER Q:XUM>0 XUM ;User can't sign on for some reason.
|
|---|
| 79 | S RET(5)=0 ;The next line sends the post sign-on msg
|
|---|
| 80 | F %=1:1 Q:'$D(XUTEXT(%)) S RET(5+%)=$E(XUTEXT(%),2,256),RET(5)=%
|
|---|
| 81 | I '$$SHOWPOST^XUSRB S RET(5)=0 ;This line stops the send/display of the msg.
|
|---|
| 82 | D:'$G(CVC) POST2
|
|---|
| 83 | Q 0
|
|---|
| 84 | ;
|
|---|
| 85 | POST2 D:'$D(XUNOW) NOW
|
|---|
| 86 | D DUZ^XUS1A,SAVE^XUS1,LOG^XUS1,ABT^XQ12
|
|---|
| 87 | D KILL^XWBSEC("XUS XOPT"),CLRFAC^XUS3($G(IO("IP"))) ;p265
|
|---|
| 88 | K XUTEXT,XOPT,XUEON,XUEOFF,XUTT,XUDEV,XUSER
|
|---|
| 89 | Q
|
|---|
| 90 | ;
|
|---|
| 91 | NOW ;
|
|---|
| 92 | S U="^",XUNOW=$$NOW^XLFDT(),DT=$P(XUNOW,".")
|
|---|
| 93 | Q
|
|---|
| 94 | USER() ;
|
|---|
| 95 | N %B,%E,%T,I1,X1,X2
|
|---|
| 96 | K XUTEXT
|
|---|
| 97 | S XUTEXT=0,DUZ(2)=$G(DUZ(2),0)
|
|---|
| 98 | F I=0:0 S I=$O(^XTV(8989.3,1,"POST",I)) Q:I'>0 D SET("!"_$G(^(I,0)))
|
|---|
| 99 | D SET("!"),XOPT^XUS
|
|---|
| 100 | S %H=$P($H,",",2)
|
|---|
| 101 | D SET("!Good "_$S(%H<43200:"morning ",%H<61200:"afternoon ",1:"evening ")_$S($P(XUSER(1),U,4)]"":$P(XUSER(1),U,4),1:$P(XUSER(0),U,1)))
|
|---|
| 102 | S I1=$G(^VA(200,DUZ,1.1)),X=(+I1_"0000")
|
|---|
| 103 | I X D SET("! You last signed on "_$S(X\1=DT:"today",X\1+1=DT:"yesterday",1:$$FMTE^XLFDT(X,"1D"))_" at "_$E(X,9,10)_":"_$E(X,11,12))
|
|---|
| 104 | I $P(I1,"^",2) S I=$P(I1,"^",2) D SET("!There "_$S(I>1:"were ",1:"was ")_I_" unsuccessful attempt"_$S(I>1:"s",1:"")_" since you last signed on.")
|
|---|
| 105 | I $P(XUSER(0),U,12),$$PH(%H,$P(XUSER(0),U,12)) Q 17 ;Time frame
|
|---|
| 106 | I +$P(XOPT,U,15) S %=$P(XOPT,U,15)-($H-XUSER(1)) I %<6,%>0 D SET("! Your Verify code will expire in "_%_" days")
|
|---|
| 107 | ;Report new Mail
|
|---|
| 108 | N XUXM S %=$$NU^XMGAPI4(1,1,"XUXM") I $G(XUXM) F %=0:0 S %=$O(XUXM(%)) Q:%'>0 D SET("!"_XUXM(%))
|
|---|
| 109 | ;S:$P(XOPT,"^",5) XUTT=1 S DTIME=$P(XOPT,U,10)
|
|---|
| 110 | ;Check Multiple Sign-on allowed, X1 signed on flag, X2 0=No,1=Yes,2=1IP
|
|---|
| 111 | ;S X1=$P($G(^VA(200,DUZ,1.1)),U,3),X2=$P(XOPT,U,4)
|
|---|
| 112 | ;I 'X2,X1 Q 9 ;Multi Sign-on not allowed
|
|---|
| 113 | ;I X2=2 D Q:%B>0 %B ;Only from one IP
|
|---|
| 114 | ;. S %B=0 I '$D(IO("IP")) S:X1 %B=9 Q ;Can't tell IP,
|
|---|
| 115 | ;. S X1=$$COUNT(DUZ,IO("IP")),%B=$S(X1<0:9,(X1+1)>$P(XOPT,U,19):9,1:0)
|
|---|
| 116 | USX ;S $P(^VA(200,DUZ,1.1),U,3)=1
|
|---|
| 117 | ;Call XQOR to handle SIGN-ON protocall.
|
|---|
| 118 | ;N XUSER,XUSQUIT ;Protect ourself.
|
|---|
| 119 | ;S DIC="^DIC(19,",X="XU USER SIGN-ON",XUSQUIT=0
|
|---|
| 120 | ;D EN^XQOR
|
|---|
| 121 | Q 0 ;If protocol set XUSQUIT will stop sign-on.
|
|---|
| 122 | ;
|
|---|
| 123 | SET(V) ;Set into XUTEXT(XUTEXT), Also Called from XU USER SIGN-ON protocol.
|
|---|
| 124 | S XUTEXT=$G(XUTEXT)+1,XUTEXT(XUTEXT)=V
|
|---|
| 125 | Q
|
|---|
| 126 | ;
|
|---|
| 127 | PH(%T,%R) ;Check Prohibited time for R/S
|
|---|
| 128 | N MSG S MSG=$$PROHIBIT(%T,%R)
|
|---|
| 129 | I MSG S XUM(0)=$P(MSG,U,2) Q 1
|
|---|
| 130 | D SET("!"),SET("! "_$$EZBLD^DIALOG(30810.62)_" "_$P(MSG,U,2))
|
|---|
| 131 | Q 0
|
|---|
| 132 | ;
|
|---|
| 133 | PROHIBIT(%T,%R) ;See if a prohibited time, (Time from $H, restrict range)
|
|---|
| 134 | N XMSG,%B,%E
|
|---|
| 135 | S %T=%T\60#60+(%T\3600*100),%B=$P(%R,"-",1),%E=$P(%R,"-",2)
|
|---|
| 136 | S XMSG=$P($$FMTE^XLFDT(DT_"."_%B,"2P")," ",2,3)_" "_$$EZBLD^DIALOG(30810.61)_" "_$P($$FMTE^XLFDT(DT_"."_%E,"2P")," ",2,3)
|
|---|
| 137 | I $S(%E'<%B:%T'>%E&(%T'<%B),1:%T>%B!(%T<%E)) Q "1^"_XMSG ;No
|
|---|
| 138 | Q "0^"_XMSG
|
|---|
| 139 | ;
|
|---|
| 140 | SET1(FLAG) ;Setup for FATKAAT
|
|---|
| 141 | N %
|
|---|
| 142 | S U="^"
|
|---|
| 143 | D XUVOL^XUS,XOPT^XUS
|
|---|
| 144 | S XUDEV=0,XUIOP=""
|
|---|
| 145 | D GETFAC^XUS3($G(IO("IP")))
|
|---|
| 146 | S %=$P(XOPT,U,14)
|
|---|
| 147 | Q
|
|---|
| 148 | SET2() ;EF. Return error code
|
|---|
| 149 | N %,X
|
|---|
| 150 | S XUNOW=$$HTFM^XLFDT($H),DT=$P(XUNOW,".")
|
|---|
| 151 | K DUZ,XUSER
|
|---|
| 152 | S (DUZ,DUZ(2))=0,(DUZ(0),DUZ("AG"),XUSER(0),XUSER(1),XUTT,%UCI)=""
|
|---|
| 153 | S %=$$INHIBIT^XUSRB() I %>0 Q %
|
|---|
| 154 | S DTIME=600
|
|---|
| 155 | I '$P(XOPT,U,11),$D(^%ZIS(1,XUDEV,90)),^(90)>2800000,^(90)'>DT Q 8
|
|---|
| 156 | I $D(XRT0) S XRTN="XUS" D T1^%ZOSV
|
|---|
| 157 | Q 0
|
|---|
| 158 | ;
|
|---|
