source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCUTBK3.m@ 1141

Last change on this file since 1141 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 4.2 KB
RevLine 
[613]1SCUTBK3 ;MJK/ALB - RPC Broker Utilities ; SEP 99
2 ;;5.3;Scheduling;**41,51,177,204**;AUG 13, 1993
3 ;
4GETUSER(SCDATA,SCDUZ) ; -- get user data
5 ;
6 ; input: SCDUZ -> user's id (DUZ)
7 ;output: for success SCDATA(0) -> duz ^ name ^ default query id ^ default institution name
8 ; for failure SCDATA(0) -> 0 ^ <number of errors>
9 ; (1...n) -> error text
10 ;
11 ; Related RPC: SCUT GET USER RECORD
12 ;
13 ;
14 ;I $$VAPVER(XWBAPVER) D CLOSE^%ZISTCP Q ;old clients off / future
15 N X,DIERR,SCPARM
16 IF SCDUZ="CURRENT USER" S SCDUZ=+$G(DUZ)
17 S X=$G(^VA(200,+SCDUZ,0))
18 IF X]"" D
19 . N Y
20 . S SCDATA(0)=+SCDUZ_U_$P(X,U)_U_$$DEFAULT(SCDUZ)
21 . D GETENV^%ZOSV
22 . S SCDATA(0)=SCDATA(0)_U_Y_U_$P($G(^DIC(4,DUZ(2),0)),U,1)
23 ELSE D
24 . S SCPARM("USER ID")=SCDUZ
25 . D BLD^DIALOG(4030005.001,.SCPARM,"","SCDATA","S")
26 . D HDREC(.SCDATA,$G(DIERR),"Scheduling User Data Retrieval")
27 Q
28 ;
29DEFAULT(SCDUZ) ; -- get default query for user
30 N X
31 S X=+$P($G(^SCRS(403.35,+SCDUZ,"PCMM")),U,15)
32 IF 'X S X=+$O(^SD(404.95,"B","System Default",0))
33 S X=X_U_$P($G(^SD(404.95,+X,0),"Unknown"),U)
34 Q X
35 ;
36SETDEF(SCDATA,SCDUZ,SCQRY) ; -- set user's default query
37 ; input: SCDUZ -> user's id (DUZ)
38 ; SCQRY ->query ien
39 ;output: for success SCDATA(0) -> 1
40 ; for failure SCDATA(0) -> 0 ^ <number of errors>
41 ; (1...n) -> error text
42 ;
43 ;
44 ; Related RPC: SCUT SET USER QUERY DEFAULT
45 ;
46 N SCVAL,SCFDA,SCIENS,SCERR,DIERR,SCPROC
47 S SCPROC="Setting User Query Default"
48 S SCFDA="SCFDA",SCIENS="SCIENS",SCERR="SCERR"
49 ; -- make sure user has param rec
50 IF '$D(^SCRS(403.35,+SCDUZ,0)) D G:$O(SCDATA(0)) SETDEFQ
51 . D FDA^DILF(403.35,"+1,",.01,"",+SCDUZ,SCFDA,SCERR)
52 . S SCIENS(1)=+SCDUZ
53 . D UPDATE^DIE("",SCFDA,SCIENS,SCERR)
54 . D ERRCHK(.SCDATA,.SCERR,SCPROC)
55 ;
56 ; -- set default
57 K SCFDA,SCIENS,SCERR,SCVAL
58 S SCFDA="SCFDA",SCIENS="SCIENS",SCERR="SCERR"
59 S SCVAL=$S(SCQRY:SCQRY,1:"@")
60 D FDA^DILF(403.35,+SCDUZ_",",1.15,"",SCVAL,SCFDA,SCERR)
61 D FILE^DIE("K",SCFDA,SCERR)
62 D ERRCHK(.SCDATA,.SCERR,"Setting User Query Default")
63SETDEFQ Q
64 ;
65VERPAT(SCRESULT,SCPATCH) ;
66 ; for rpc SCMC VERIFY C/S SYNC
67 ; input := ServerPatch^ClientVersion
68 ; output := SCRESULT: 0 = Not Continue
69 ; 1 = Continue (pre SD*5.3*204)
70 ; n = RpcTimeLimit (after SD*5.3*204)
71 ;
72 N SCX
73 ;
74 ; site turned off all clients?
75 S SCRESULT=$$DISCLNTS^SCMCUT()'=1
76 I SCRESULT=0 Q
77 ;
78 ; hook for complex RPCVersion checker
79 S SCRESULT=$$VAPVER(XWBAPVER)
80 ;
81 ; if programmer, OK, quit
82 I $$VPROGMR() Q
83 ;
84 ; hook for complex patch existence checker
85 I $$VPATCH(SCPATCH)'=1 S SCRESULT=0 Q
86 ;
87 ; hook for complex executable version checker
88 I $$VCLIENT(SCPATCH) S SCRESULT=0
89 ;
90 Q
91 ;
92VPROGMR() ; check if user is programmer
93 N SCX
94 D SECKEY^SCUTBK11(.SCX,"XUPROG")
95 Q SCX=1
96 ;
97VAPVER(SCX) ; check client RPCVersion
98 ; ; input SCX := client RPCVersion(server XWBAPVER)
99 ; ; output := RpcTimeLimit
100 I +SCX<204 Q 1
101 S SCX=+$O(^SCTM(404.44,0))
102 I SCX<1 Q 0
103 S SCX=+$P($G(^SCTM(404.44,SCX,1)),U,4)
104 Q $S(SCX<30:30,SCX>300:300,1:SCX)
105 ;
106VCLIENT(SCX) ; check executable version/update if new
107 ; ; input SCX := server^client (versions)
108 ;Q 0 ; hook for more complex checker
109 N SCSER,SCCLI
110 S SCSER=$P(SCX,U)
111 I SCSER']"" Q 1
112 S SCCLI=$P(SCX,U,2)
113 I SCCLI']"" Q 1
114 ;
115 ;OK if on active list
116 N SC1,SC1LIST
117 S SC1=$$CLNLST^SCMCUT(SCSER,"SC1LIST",1)
118 I SC1,$D(SC1LIST(SCCLI)) Q 0
119 ;
120 ;stop if on inactive list
121 N SC2,SC2LIST
122 S SC2=$$CLNLST^SCMCUT(SCSER,"SC2LIST",0)
123 I SC2,$D(SC2LIST(SCCLI)) Q 1
124 ;
125 ;add client/server pair, OK if update
126 Q '$$UPCLNLST^SCMCUT(SCX)
127 ;
128VPATCH(SCX) ; check server version
129 ; ; input SCX := server^client (versions)
130 Q $$PATCH^XPDUTL($P(SCX,U))
131 ;
132 ; >>>> Error Processing Utilities <<<<
133 ;
134HDREC(SCDATA,SCER,SCPROC) ; -- build zeroth of SCDATA array
135 IF SCER D
136 . S SCDATA(0)=0_U_+SCER_U
137 . D SETPROC(.SCDATA,.SCPROC)
138 ELSE D
139 . S SCDATA(0)=1_U_U ; no errors
140 Q
141 ;
142SETPROC(SCDATA,SCPROC) ; -- set process name for error list
143 S $P(SCDATA(0),U,3)=SCPROC
144 Q
145 ;
146ERRCHK(SCDATA,SCERR,SCPROC) ; -- process fileman dbs errors
147 N SCERS
148 S SCERS=$G(SCERR("DIERR"))
149 IF SCERS D MSG^DIALOG("EA",.SCDATA,"","",SCERR)
150 D HDREC(.SCDATA,SCERS,SCPROC)
151 Q
152 ;
Note: See TracBrowser for help on using the repository browser.