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

SCUTBK3.m

Go to the documentation of this file. 
  1. SCUTBK3 ;MJK/ALB - RPC Broker Utilities ; SEP 99
  1.  ;;5.3;Scheduling;**41,51,177,204**;AUG 13, 1993
  1.  ;
  1. GETUSER(SCDATA,SCDUZ) ; -- get user data
  1.  ;
  1.  ; input:                 SCDUZ -> user's id (DUZ)
  1.  ;output: for success SCDATA(0) -> duz ^ name ^ default query id ^ default institution name
  1.  ;        for failure SCDATA(0) -> 0 ^ <number of errors>
  1.  ;                      (1...n) -> error text
  1.  ;
  1.  ; Related RPC: SCUT GET USER RECORD
  1.  ;
  1.  ;
  1.  ;I $$VAPVER(XWBAPVER) D CLOSE^%ZISTCP Q  ;old clients off / future
  1.  N X,DIERR,SCPARM
  1.  IF SCDUZ="CURRENT USER" S SCDUZ=+$G(DUZ)
  1.  S X=$G(^VA(200,+SCDUZ,0))
  1.  IF X]"" D
  1.  . N Y
  1.  . S SCDATA(0)=+SCDUZ_U_$P(X,U)_U_$$DEFAULT(SCDUZ)
  1.  . D GETENV^%ZOSV
  1.  . S SCDATA(0)=SCDATA(0)_U_Y_U_$P($G(^DIC(4,DUZ(2),0)),U,1)
  1.  ELSE  D
  1.  . S SCPARM("USER ID")=SCDUZ
  1.  . D BLD^DIALOG(4030005.001,.SCPARM,"","SCDATA","S")
  1.  . D HDREC(.SCDATA,$G(DIERR),"Scheduling User Data Retrieval")
  1.  Q
  1.  ;
  1. DEFAULT(SCDUZ) ; -- get default query for user
  1.  N X
  1.  S X=+$P($G(^SCRS(403.35,+SCDUZ,"PCMM")),U,15)
  1.  IF 'X S X=+$O(^SD(404.95,"B","System Default",0))
  1.  S X=X_U_$P($G(^SD(404.95,+X,0),"Unknown"),U)
  1.  Q X
  1.  ;
  1. SETDEF(SCDATA,SCDUZ,SCQRY) ; -- set user's default query
  1.  ; input:                 SCDUZ -> user's id (DUZ)
  1.  ;                        SCQRY ->query ien
  1.  ;output: for success SCDATA(0) -> 1
  1.  ;        for failure SCDATA(0) -> 0 ^ <number of errors>
  1.  ;                      (1...n) -> error text
  1.  ;
  1.  ;
  1.  ; Related RPC: SCUT SET USER QUERY DEFAULT
  1.  ;
  1.  N SCVAL,SCFDA,SCIENS,SCERR,DIERR,SCPROC
  1.  S SCPROC="Setting User Query Default"
  1.  S SCFDA="SCFDA",SCIENS="SCIENS",SCERR="SCERR"
  1.  ; -- make sure user has param rec
  1.  IF '$D(^SCRS(403.35,+SCDUZ,0)) D  G:$O(SCDATA(0)) SETDEFQ
  1.  . D FDA^DILF(403.35,"+1,",.01,"",+SCDUZ,SCFDA,SCERR)
  1.  . S SCIENS(1)=+SCDUZ
  1.  . D UPDATE^DIE("",SCFDA,SCIENS,SCERR)
  1.  . D ERRCHK(.SCDATA,.SCERR,SCPROC)
  1.  ;
  1.  ; -- set default
  1.  K SCFDA,SCIENS,SCERR,SCVAL
  1.  S SCFDA="SCFDA",SCIENS="SCIENS",SCERR="SCERR"
  1.  S SCVAL=$S(SCQRY:SCQRY,1:"@")
  1.  D FDA^DILF(403.35,+SCDUZ_",",1.15,"",SCVAL,SCFDA,SCERR)
  1.  D FILE^DIE("K",SCFDA,SCERR)
  1.  D ERRCHK(.SCDATA,.SCERR,"Setting User Query Default")
  1. SETDEFQ Q
  1.  ;
  1. VERPAT(SCRESULT,SCPATCH) ;
  1.  ;       for rpc SCMC VERIFY C/S SYNC
  1.  ;       input  := ServerPatch^ClientVersion
  1.  ;       output := SCRESULT: 0 = Not Continue
  1.  ;                           1 = Continue (pre SD*5.3*204)
  1.  ;                           n = RpcTimeLimit (after SD*5.3*204)
  1.  ;
  1.  N SCX
  1.  ;
  1.  ; site turned off all clients?
  1.  S SCRESULT=$$DISCLNTS^SCMCUT()'=1
  1.  I SCRESULT=0 Q
  1.  ;
  1.  ; hook for complex RPCVersion checker
  1.  S SCRESULT=$$VAPVER(XWBAPVER)
  1.  ;
  1.  ; if programmer, OK, quit
  1.  I $$VPROGMR() Q
  1.  ;
  1.  ; hook for complex patch existence checker
  1.  I $$VPATCH(SCPATCH)'=1 S SCRESULT=0 Q
  1.  ;
  1.  ; hook for complex executable version checker
  1.  I $$VCLIENT(SCPATCH) S SCRESULT=0
  1.  ;
  1.  Q
  1.  ;
  1. VPROGMR() ; check if user is programmer
  1.  N SCX
  1.  D SECKEY^SCUTBK11(.SCX,"XUPROG")
  1.  Q SCX=1
  1.  ;
  1. VAPVER(SCX) ; check client RPCVersion
  1.  ;       ; input SCX := client RPCVersion(server XWBAPVER)
  1.  ;       ; output    := RpcTimeLimit
  1.  I +SCX<204 Q 1
  1.  S SCX=+$O(^SCTM(404.44,0))
  1.  I SCX<1 Q 0
  1.  S SCX=+$P($G(^SCTM(404.44,SCX,1)),U,4)
  1.  Q $S(SCX<30:30,SCX>300:300,1:SCX)
  1.  ;
  1. VCLIENT(SCX) ; check executable version/update if new
  1.  ;       ; input SCX := server^client (versions)
  1.  ;Q 0     ; hook for more complex checker
  1.  N SCSER,SCCLI
  1.  S SCSER=$P(SCX,U)
  1.  I SCSER']"" Q 1
  1.  S SCCLI=$P(SCX,U,2)
  1.  I SCCLI']"" Q 1
  1.  ;
  1.  ;OK if on active list
  1.  N SC1,SC1LIST
  1.  S SC1=$$CLNLST^SCMCUT(SCSER,"SC1LIST",1)
  1.  I SC1,$D(SC1LIST(SCCLI)) Q 0
  1.  ;
  1.  ;stop if on inactive list
  1.  N SC2,SC2LIST
  1.  S SC2=$$CLNLST^SCMCUT(SCSER,"SC2LIST",0)
  1.  I SC2,$D(SC2LIST(SCCLI)) Q 1
  1.  ;
  1.  ;add client/server pair, OK if update
  1.  Q '$$UPCLNLST^SCMCUT(SCX)
  1.  ;
  1. VPATCH(SCX) ; check server version
  1.  ;       ; input SCX := server^client (versions)
  1.  Q $$PATCH^XPDUTL($P(SCX,U))
  1.  ;
  1.  ; >>>> Error Processing Utilities <<<<
  1.  ;
  1. HDREC(SCDATA,SCER,SCPROC) ; -- build zeroth of SCDATA array
  1.  IF SCER D
  1.  . S SCDATA(0)=0_U_+SCER_U
  1.  . D SETPROC(.SCDATA,.SCPROC)
  1.  ELSE  D
  1.  . S SCDATA(0)=1_U_U ; no errors
  1.  Q
  1.  ;
  1. SETPROC(SCDATA,SCPROC) ; -- set process name for error list
  1.  S $P(SCDATA(0),U,3)=SCPROC
  1.  Q
  1.  ;
  1. ERRCHK(SCDATA,SCERR,SCPROC) ; -- process fileman dbs errors
  1.  N SCERS
  1.  S SCERS=$G(SCERR("DIERR"))
  1.  IF SCERS D MSG^DIALOG("EA",.SCDATA,"","",SCERR)
  1.  D HDREC(.SCDATA,SCERS,SCPROC)
  1.  Q
  1.  ;