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