Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: BGUXUSRB

BGUXUSRB.m

Go to the documentation of this file. 
  1. BGUXUSRB ; IHS/OIT/MJL - Request Broker ; [ 04/18/2006   2:21 PM ]
  1.  ;;1.5;BGU;**1,2**;MAY 26, 2005
  1.  Q  ;No entry from top
  1.  ;
  1.  ;DATA BROKER calls, First parameter is always call-by-reference
  1.  ;
  1. VALIDAV(RESULT,ACODE,VCODE,BGUETH,BGUAPP,BGUPRM) ;EP Check a users access
  1.  ;Return user's name&DUZ^FM access codes^change code^# facility entries;Default facility&IEN;Facility&IEN;n times^Calling application parameter space holder  -- ihs's
  1.  ;  ACODE=ACCESS CODE ENCRIPTED FROM CLIENT
  1.  ;  VCODE=VERIFY CODE ENCRIPTED FROM CLIENT
  1.  ; BGUETH=ETHERNET HEX ADDRESS OF CLIENT CARD
  1.  ; BGUAPP=APPLICATION ID/VERSION
  1.  ; BGUPRM=SECURITY PARAMETER PASSED BY CLIENT
  1.  ;
  1.  ;1/24/97SWC- tags/externals used :
  1.  ;A1, SET1, $$CHECKAV, $$VCVALID(), $$NO(), $$GETFC^BGUGFAC(DUZ)
  1.  ;S AVCODE=$$DECRYP(AVCODE)
  1.  D A1
  1.  D SET1
  1.  ;N X,XUSER,XUF,%1 S U="^",XUF=0,DUZ=$$CHECKAV^XUS(ACODE,VCODE,XUSER)
  1.  N X,XUSER,XUF,%1,XUERR
  1.  S U="^",XUF=0,XUSER="",DUZ=$$CHECKAV(ACODE,VCODE,.XUSER)
  1.  ;I- RESULT(1) = 0 ^ N1 ^ N2 ^ ERROR-MSG-TEXT
  1.  ;So in OCX, once it is determined that it is an error, I know that if
  1.  ;$P(XUERR,U,2)=0, non-fatal XUERR error.=1, FATAL error. If
  1.  ;$P(XUERR,U,3) =12, then trigger Modify Verify dlgbox.
  1.  ;( Currently, we only care about XUM=12. )
  1.  S VCOK=$$VCVALID()
  1.  I VCOK=1 S XUM=12,XUERR=$$NO() D SNDER Q  ;,RESULT(1)=0_U_XUGUIER
  1.  ;IB- Temp-Insert 1 line, ONLY when TESTING for GUI VERIFY modify
  1.  ;I DUZ=613 S XUM=12,XUERR=$$NO() D SNDER Q  ;me. 604=FJ in [APD,AAA] only.
  1.  ;
  1.  ;I $G(DUZ)>0 S RESULT(1)=$P(^VA(200,DUZ,0),U)_"&"_DUZ_U_$P(^VA(200,DUZ,0),U,4)_U_0_U_"2;SELLS HOSPITAL&4587;SAN XAVIER CLINIC&4585"_U_""
  1.  I $G(DUZ)>0 S RESULT(1)=$P(^VA(200,DUZ,0),U)_"&"_DUZ_U_$P(^VA(200,DUZ,0),U,4)_U_0_U_$$GETFC^BGUGFAC(DUZ)_U_"",$P(^VA(200,DUZ,1.1),U,1)=$$NOW^XLFDT D:$G(WEB) DUZ^XUP(DUZ)
  1.  ; When the Listener isn't running the string returned to the client
  1.  ; is the same as an A/V failure.
  1.  ; The zero is set in the 3rd piece to differentiate between a true A/V
  1.  ; failure and the Listener not running. (This routine isn't called if
  1.  ; the Listener isn't running.)
  1.  E  S RESULT(1)=0_U_XUSER("ERR")_U_0
  1.  Q
  1.  ;
  1. INTRO(RESULT) ;Return INTRO TEXT.
  1.  D INTRO^XUS1A("RESULT")
  1.  Q
  1.  ;
  1. CVC(RESULT,XU1) ;change VC
  1.  S RESULT(1)=0 Q:$G(DUZ)'>0  N XU2 S U="^",XU2=$P(XU1,U,2),XU1=$P(XU1,U)
  1.  ;S XU1=$$DECRYP(XU1),XU2=$$DECRYP(XU2)
  1.  ;Q $$XXCVC^XUS2(XU1,XU2)
  1.  S RESULT(1)=0
  1.  Q
  1.  ;
  1. CAC(RESULT,XU1) ;change AC
  1.  S RESULT(1)=0 Q:$G(DUZ)'>0  N XU2 S U="^",XU2=$P(XU1,U,2),XU1=$P(XU1,U)
  1.  ;S XU1=$$DECRYP(XU1),XU2=$$DECRYP(XU2)
  1.  ;Q $$XXCVC^XUS2(XU1,XU2)
  1.  S RESULT(1)=0
  1.  Q
  1.  ;
  1. CFAC(RESULT,XU1) ; change facility id (DUZ(2))
  1.  S:'$D(DUZ(2)) DUZ(2)=$G(XU1)
  1.  I +DUZ(2)<1 S XUM=4,XUERR=$$NO() D SNDER Q
  1.  S:$D(DUZ("AG")) DUZ("AG")=""
  1.  S:'$D(DUZ("AG")) DUZ("AG")=""
  1.  D:DUZ(2)'=""
  1.  .S BGUX=$P($G(^DIC(4,DUZ(2),99)),"^",5)
  1.  .S:DUZ("AG")="" DUZ("AG")=$S(BGUX'="":BGUX,1:$P($G(^XTV(8989.3,1,0)),"^",8))
  1.  S RESULT(1)=0
  1.  Q
  1.  ;
  1. SETUP(RESULT) ;sets up environment for GUI signon
  1.  D SET1^XUS
  1.  S RESULT(0)=$P(XUENV,U,3) ;server name
  1.  S RESULT(1)=$P(XUVOL,U) ; volume
  1.  S RESULT(2)=XUCI ; uci
  1.  S RESULT(3)=$G(IO) ; device
  1.  Q
  1.  ;
  1. A1 ;Set some basics.
  1.  S U="^",DT=$$DT^XLFDT()
  1.  Q
  1.  ;
  1. CHECKAV(X1,X2,USER) ;Check A/V code return DUZ
  1.  N %,X,Y
  1.  K USER("ERR")
  1.  ;[] ":" is a char in the hashed code. it will have to be
  1.  ;                  changed to something else. Ask for terminal type.
  1.  ;[]D- per Jim- S:X1[":" XUTT=1,X1=$P(X1,":",1)_$P(X1,":",2)
  1.  ;D ^XBKSET ;sets env var and default vt type  fje
  1.  ;[]";",  a char in the hashed code. use $C(30) instead.
  1.  ;              WAIT TILL hORACE CHANGES HIS OCX CODE.
  1.  ;S X=$P(X1,";")
  1.  S X=X1
  1.  Q:X="^" -1
  1.  S:XUF %1="Access: "_X G CHX:X'?1.20ANP
  1.  ;[]D- eliminate these 2 calls.
  1.  ;I- Put back for WEB
  1.  I $G(WEB) D LC^XUS,^XUSHSH
  1.  ;
  1.  I '$D(^VA(200,"A",X)) S USER("ERR")="Invalid Access Code" G CHX
  1.  S %1="",DUZ=$O(^VA(200,"A",X,0)),USER(0)=^VA(200,DUZ,0),USER(1)=$G(^VA(200,DUZ,.1)),XUF(.3)=DUZ
  1.  ;S X=$P(X1,";",2) S:XUF %1="Verify: "_X
  1.  S X=X2 S:XUF %1="Verify: "_X
  1.  ;S X=$P(X1,";")
  1.  ;[]D- Eliminate these 2 calls.
  1.  ;I- Put back for WEB
  1.  I $G(WEB) D LC^XUS,^XUSHSH
  1.  ;
  1.  I $P(USER(1),"^",2)'=X S USER("ERR")="Invalid Verify Code" G CHX
  1.  I '$$ACTIVE^XUSER(DUZ) S USER("ERR")="No Access Allowed for this User." G CHX
  1.  Q DUZ
  1. CHX I DUZ S X=$P($G(^VA(200,DUZ,1.1)),U,2)+1,$P(^(1.1),"^",2)=X
  1.  Q 0
  1.  ;
  1. SET1 ;Setup parameters
  1.  D GETENV^%ZOSV S U="^",XUENV=Y,XUCI=$P(Y,U,1),XQVOL=$P(Y,U,2),XUEON=^%ZOSF("EON"),XUEOFF=^%ZOSF("EOFF")
  1.  ;I- needs XOPT defined - used in NO()
  1.  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)
  1.  K ^XUTL("XQ",$J) S XUT=0,XUF=0,XUDEV=0,DUZ=0,DUZ(0)="@",%ZIS="L",IOP="HOME" ;D ^%ZIS Q:POP
  1.  ;S XUDEV=IOS,XUIOP=ION
  1.  Q
  1.  ;
  1.  ;----------------------------------------------------------------
  1.  ;-D- VCVALID() ;Check if the Verify code needs changing.
  1.  ;-D- Q:'$G(DUZ) 1
  1.  ;-D- Q $G(^VA(200,DUZ,.1))+$P(^XTV(8989.3,1,"XUS"),"^",15)'>(+$H)
  1.  ;
  1. VCVALID() ;-^XUSRB-Return 1 if Verify code needs changing.
  1.  ;to process error code 12, also prepare for other codes a little.
  1.  Q:'$G(DUZ) 3
  1.  Q:$P($G(^VA(200,DUZ,.1)),U,2)="" 2
  1.  ;FHL 11/5/97
  1.  S BGULIM=+$P($G(^XTV(8989.3,1,"XUS")),"^",15) S:'BGULIM BGULIM=365
  1.  ;Q $G(^VA(200,DUZ,.1))+$P($G(^XTV(8989.3,1,"XUS")),"^",15)'>(+$H)
  1.  Q $G(^VA(200,DUZ,.1))+BGULIM'>(+$H)
  1.  ;--- - NO(), TXT(%), and ZZ are tags modified from ^XUS3.
  1. NO() ;Fail - - modified from ^XUS3
  1.  ;OUTPUTS : returns N1 ^ N2 ^ Error msg text
  1.  ;N1=XUX2 = 0, non-fatal error.=1, fatal error.
  1.  ;N2=XUX1 = Error Msg number.
  1.  N XUEX,XUX1,XUX2,XUTXT
  1.  S XUT=$G(XUT)+1
  1.  ;D- I '$D(XGWIN) W !,"Device: ",$I,!,$$TXT(XUM),!
  1.  ;R- I $D(XGWIN) D ^XGLMSG("W",$$TXT(XUM))
  1.  S XUX1=XUM,XUTXT=$$TXT(XUM)
  1.  ;R- Let GUI know whether this is a FATAL error.
  1.  ;R- I ('XUEX)&(XUT<$P(XOPT,U,2)) Q 0 ;Continue
  1.  S XUX2=1 I ('XUEX)&(XUT<$P(XOPT,U,2)) S XUX2=0 ;Continue - NON FATAL
  1.  Q XUX2_U_XUX1_U_XUTXT
  1.  ;D- Ignore the rest- Assume the number of times user
  1.  ;messed up does not matter for now on GUI.
  1.  ;D- I 'XUEX&(XUM-7) D
  1.  ;D- . I $D(XGWIN) D ^XGLMSG("I",$$TXT(7))
  1.  ;D- . I '$D(XGWIN) W !,$$TXT(7)
  1.  ;D- I XUF S X1=IOS,X2=DT F I=1:1:XUF(.2) S X=XUF(I) D EN^XUSHSHP S XUF(I)=X
  1.  ;D- I '$D(XGWIN)&'XUEX D ^XUSTZ
  1.  ;D- H 4
  1.  ;D- Q XUEX
  1. TXT(%) ; mod from ^XUS3.%=NUM in, %=ERROR MSG out.
  1.  S %=$T(ZZ+%) S:'$D(XUEX) XUEX=$P(%,";",3)
  1.  S %=$P(%,";",4,9) I %["|" S %=$P(%,"|",1)_$G(XUM(0))_$P(%,"|",2)
  1.  Q %
  1.  ;--------------- ----------- -------------------
  1.  ; tag ZZ is USED
  1. ZZ ;;Halt;Error Messages
  1. 1 ;;1;Signons not currently allowed on this processor.
  1. 2 ;;1;Maximum number of users already signed on to this processor.
  1. 3 ;;1;This device has not been defined to the system -- contact system manager.
  1. 4 ;;0;Not a valid ACCESS CODE/VERIFY CODE pair.
  1. 5 ;;0;No Access Allowed for this User.
  1. 6 ;;0;Invalid device password.
  1. 7 ;;0;Device locked due to too many invalid sign-on attempts.
  1. 8 ;;1;This device is out of service.
  1. 9 ;;0;*** MULTIPLE SIGN-ONS NOT ALLOWED ***"
  1. 10 ;;1;You don't have access to this device.
  1. 11 ;;0;Your access code has been terminated.  Please see your site manager
  1. 12 ;;0;VERIFY CODE MUST be changed before continued use.
  1. 13 ;;1;This device may only be used outside of this time frame |
  1. 14 ;;0;'|' is not a valid UCI!
  1. 15 ;;0;'|' is not a valid program name!
  1.  ;
  1. ADDRSLT ; Add % as the new entry
  1.  ;RESULT(0.01) = Number of recs FOLLOWING 0.01, (Itself is NOT included.)
  1.  S BGUI=$G(RESULT(0.01)),BGUI=BGUI+1,RESULT(0.01)=BGUI
  1.  S RESULT(BGUI)=%
  1.  Q
  1. SNDER ;Sends error to GUI
  1.  ;For ERROR, RESULT(0.01)=-1 is required by the system convention.
  1.  ;INPUTS : XUERR = the error msg.
  1.  N BGUN ;K RESULT
  1.  S BGUN=+$G(RESULT(0.01)),RESULT(0.01)=-1
  1.  S RESULT(BGUN)="0"_U_XUERR
  1.  Q