source: WorldVistAEHR/trunk/r/SCHEDULING-SD-SC/SCMCUT.m@ 975

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

initial load of WorldVistAEHR

File size: 6.0 KB
Line 
1SCMCUT ;ALB/JLU;General utility routine;8/17/99@1515
2 ;;5.3;Scheduling;**177,205,204**;AUG 13, 1993
3 ;
4 ;This is a general utility routine for the PCMM application. Any
5 ;general purpose utility should be placed in this routine.
6 ;
7 ;
8CLNLST(SER,ARY,ACT) ;
9 ;This API is a function that returns the list of clients that
10 ;can run with the server that is passed in.
11 ;
12 ;INPUTs: SER --- This is the server to check for. It needs to be in
13 ; a patch format Ex. SD*5.3*177
14 ; ARY --- This is the array root the list will be returned in.
15 ; If nothing is passed in a default will be used. This
16 ; array must be clean before it is passed to this API.
17 ; No kills will be issued.
18 ; Ex. ^TMP("PCMM CLIENT LIST",$J,"1.2.0.0")=effective dt
19 ; ^TMP("PCMM CLIENT LIST",$J,"1.3.0.0")=effective dt
20 ; ACT --- This variable indicates whether to:
21 ; 1 - return only active clients (default)
22 ; 0 - return all clients
23 ;
24 ;OUTPUTS --- The output of this function call is the data in the array
25 ; variable but also the function itself. It will either be
26 ; 1 for a success or -1 with an error message.
27 ; Ex. "-1^not a valid server name"
28 ; "1"
29 ;
30 N RESULTS
31 ;
32 ;checking input parameters
33 S SER=$G(SER)
34 I SER']"" S RESULTS="-1^Server variable not defined." G CLNLSTQ
35 S ARY=$G(ARY)
36 I ARY']"" S ARY=$NA(^TMP("PCMM CLIENT LIST",$J))
37 S ACT=$G(ACT,1)
38 ;
39 ;checking existance of server in PCMM SERVER PATCH file.
40 I '$D(^SCTM(404.45,"B",SER)) S RESULTS="-1^This server is not in the PCMM SERVER PATCH file." G CLNLSTQ
41 ;
42 ;if ACT, checking if server is active
43 I ACT,'$$ACTSER(SER) S RESULTS="-1^This server is not active." G CLNLSTQ
44 ;
45 ;loop through the server patches and build the list of clients.
46 N CLT,SERIEN
47 S CLT="",RESULTS="-1^No clients found for this Server."
48 ;
49 F S CLT=$O(^SCTM(404.45,"ASER",SER,CLT)) Q:CLT="" S SERIEN=$O(^SCTM(404.45,"ASER",SER,CLT,"")) Q:SERIEN="" DO
50 .N NOD5,NOD6
51 .S NOD5=$G(^SCTM(404.45,SERIEN,0))
52 .Q:NOD5=""
53 .S NOD6=$G(^SCTM(404.46,$P(NOD5,U,2),0))
54 .Q:NOD6=""
55 .I ACT,$P(NOD6,U,2),$D(^SCTM(404.45,"ACT",SER,SERIEN)) S @ARY@($P(NOD6,U,1))=$P(NOD6,U,2,3),RESULTS=1
56 .I 'ACT S @ARY@($P(NOD6,U,1))=$P(NOD6,U,2,3),RESULTS=1
57 .Q
58 ;
59CLNLSTQ Q RESULTS
60 ;
61 ;
62ACTCLT(CLT) ;Is this client active?
63 ;This function call returns whether the client passed in is active or
64 ;not . It just tells the status of the client per its entry in PCMM
65 ;CLIENT PATCH file. It does not relate in anyway to the PCMM SERVER
66 ;PATCH file.
67 ;
68 ;INPUT: CLT - This is the External Client version number
69 ;
70 ;OUTPUT: 1 - ACTIVE
71 ; 0 - NOT ACTIVE
72 ; -1^ERROR DESCRIPTION
73 ;
74 N RESULTS
75 S CLT=$G(CLT)
76 I CLT']"" S RESULTS="-1^Client variable not defined." G ACTCLTQ
77 ;
78 N CLTIEN,ACT
79 S CLTIEN=$O(^SCTM(404.46,"B",CLT,0))
80 I CLTIEN="" S RESULTS="-1^Client not defined in PCMM CLIENT PATCH file." G ACTCLTQ
81 S ACT=$P(^SCTM(404.46,CLTIEN,0),U,2)
82 S RESULTS=$S(ACT:ACT,1:0) ;This was done so that a null would be zero
83 ;
84ACTCLTQ Q RESULTS
85 ;
86 ;
87ACTSER(SER,ARY) ;
88 ; This function call is used to return the status of a server
89 ; or a list of active servers at the sight.
90 ; It does not return the IENs or multiples of
91 ; the same server value.
92 ;
93 ;INPUTS SER - [optional]: Test for a specific server version
94 ; ARY - [optional]: This is the array root that the list
95 ; is to be stored in, if SER is undefined.
96 ; If nothing is passed then the default will be used.
97 ; ^TMP("PCMM ACTIVE SERVERS",$J,SERVER NUMBER)=EFFECTIVE DT
98 ;
99 ;OUTPUTS 1 - a success
100 ; 0 - none found.
101 ;
102 N RESULTS,LP,IEN
103 S SER=$G(SER,"")
104 I SER]"" S RESULTS=$D(^SCTM(404.45,"ACT",SER))>0 G ACTSERQ
105 S ARY=$G(ARY,"^TMP(""PCMM ACTIVE SERVERS"",$J)")
106 S RESULTS=0,LP=""
107 ;
108 I $O(^SCTM(404.45,"ACT",""))']"" G ACTSERQ
109 ;
110 F S LP=$O(^SCTM(404.45,"ACT",LP)) Q:LP="" S IEN=$O(^SCTM(404.45,"ACT",LP,"")) Q:IEN="" DO
111 .S IEN=$G(^SCTM(404.45,IEN,0))
112 .Q:IEN=""
113 .S @ARY@(LP)=$P(IEN,U,3)
114 .S RESULTS=1
115 .Q
116 I SER]"" S RESULTS=$D(@ARY@(SER))
117 ;
118ACTSERQ Q RESULTS
119 ;
120 ;
121DISCLNTS() ;This function call is used to determine if all clients should
122 ;be disabled.
123 ;
124 ;INPUTS -- NONE
125 ;OUTPUTS -- 1 means YES disable all clients
126 ; 0 means NO
127 ;
128 N IEN,RESULTS
129 S RESULTS=0
130 ;
131 S IEN=+$O(^SCTM(404.44,0))
132 I 'IEN G DISQ
133 S IEN=$G(^SCTM(404.44,IEN,1))
134 S RESULTS=$S('$P(IEN,U,2):0,1:1)
135 ;
136DISQ Q RESULTS
137 ;
138UPCLNLST(SCX) ;update 404.46/404.45 with new client/server pair (if enabled)
139 ; input := SCX p1[required] : ServerPatch
140 ; p2[required] : ^ClientVersion
141 ; p3[optional] : ^EnabledOverride(1=bypass,0=no[default])
142 ; p4[optional] : ^ActiveServer(1=yes[default],0=no)
143 ; p5[optional] : ^ActiveClient(1=yes[default],0=no)
144 ; output := SCRESULT : 1 = success
145 ; : 0 = failure/not allowed
146 ;
147 N SCRESULT,SCSER,SCCLI,SCASER,SCACLI,SCBYPASS,SCIEN
148 S SCRESULT=0
149 ;
150 ; parse
151 S SCSER=$P(SCX,U)
152 I SCSER']"" G UPCLNQ
153 S SCCLI=$P(SCX,U,2)
154 I SCCLI']"" G UPCLNQ
155 S SCBYPASS=$P(SCX,U,3)
156 S SCBYPASS=$S(SCBYPASS=1:1,1:0)
157 S SCIEN=+$O(^SCTM(404.44,0))
158 I 'SCIEN G UPCLNQ
159 I 'SCBYPASS,$P($G(^SCTM(404.44,SCIEN,1)),U,3)=1 G UPCLNQ
160 S SCASER=$P(SCX,U,4)
161 S SCASER=$S(SCASER=0:0,1:1)
162 S SCACLI=$P(SCX,U,5)
163 S SCACLI=$S(SCACLI=0:0,1:1)
164 ;
165 ;update client file
166 N SC1,SC1IEN,SC1ERR
167 S SC1(1,404.46,"?+1,",.01)=SCCLI ;client version
168 S SC1(1,404.46,"?+1,",.02)=SCACLI ;active?
169 S SC1(1,404.46,"?+1,",.03)=DT ;today
170 D UPDATE^DIE("","SC1(1)","SC1IEN","SC1ERR")
171 I $D(SC1ERR)!(+$G(SC1IEN(1))<0) G UPCLNQ
172 ;
173 ;update server file
174 N SC2,SC2IEN,SC2ERR
175 S SC2(1,404.45,"?+1,",.01)=SCSER ;server version
176 S SC2(1,404.45,"?+1,",.02)=SC1IEN(1) ;ptr - client version
177 S SC2(1,404.45,"?+1,",.03)=DT ;today
178 S SC2(1,404.45,"?+1,",.04)=SCASER ;active?
179 D UPDATE^DIE("","SC2(1)","SC2IEN","SC2ERR")
180 I $D(SC2ERR)!(+$G(SC2IEN(1))<0) G UPCLNQ
181 S SCRESULT=1
182 ;
183UPCLNQ Q SCRESULT
184 ;
Note: See TracBrowser for help on using the repository browser.