SCMCUT ;ALB/JLU;General utility routine;8/17/99@1515
;;5.3;Scheduling;**177,205,204**;AUG 13, 1993
;
;This is a general utility routine for the PCMM application. Any
;general purpose utility should be placed in this routine.
;
;
CLNLST(SER,ARY,ACT) ;
;This API is a function that returns the list of clients that
;can run with the server that is passed in.
;
;INPUTs: SER --- This is the server to check for. It needs to be in
; a patch format Ex. SD*5.3*177
; ARY --- This is the array root the list will be returned in.
; If nothing is passed in a default will be used. This
; array must be clean before it is passed to this API.
; No kills will be issued.
; Ex. ^TMP("PCMM CLIENT LIST",$J,"1.2.0.0")=effective dt
; ^TMP("PCMM CLIENT LIST",$J,"1.3.0.0")=effective dt
; ACT --- This variable indicates whether to:
; 1 - return only active clients (default)
; 0 - return all clients
;
;OUTPUTS --- The output of this function call is the data in the array
; variable but also the function itself. It will either be
; 1 for a success or -1 with an error message.
; Ex. "-1^not a valid server name"
; "1"
;
N RESULTS
;
;checking input parameters
S SER=$G(SER)
I SER']"" S RESULTS="-1^Server variable not defined." G CLNLSTQ
S ARY=$G(ARY)
I ARY']"" S ARY=$NA(^TMP("PCMM CLIENT LIST",$J))
S ACT=$G(ACT,1)
;
;checking existance of server in PCMM SERVER PATCH file.
I '$D(^SCTM(404.45,"B",SER)) S RESULTS="-1^This server is not in the PCMM SERVER PATCH file." G CLNLSTQ
;
;if ACT, checking if server is active
I ACT,'$$ACTSER(SER) S RESULTS="-1^This server is not active." G CLNLSTQ
;
;loop through the server patches and build the list of clients.
N CLT,SERIEN
S CLT="",RESULTS="-1^No clients found for this Server."
;
F S CLT=$O(^SCTM(404.45,"ASER",SER,CLT)) Q:CLT="" S SERIEN=$O(^SCTM(404.45,"ASER",SER,CLT,"")) Q:SERIEN="" DO
.N NOD5,NOD6
.S NOD5=$G(^SCTM(404.45,SERIEN,0))
.Q:NOD5=""
.S NOD6=$G(^SCTM(404.46,$P(NOD5,U,2),0))
.Q:NOD6=""
.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
.I 'ACT S @ARY@($P(NOD6,U,1))=$P(NOD6,U,2,3),RESULTS=1
.Q
;
CLNLSTQ Q RESULTS
;
;
ACTCLT(CLT) ;Is this client active?
;This function call returns whether the client passed in is active or
;not . It just tells the status of the client per its entry in PCMM
;CLIENT PATCH file. It does not relate in anyway to the PCMM SERVER
;PATCH file.
;
;INPUT: CLT - This is the External Client version number
;
;OUTPUT: 1 - ACTIVE
; 0 - NOT ACTIVE
; -1^ERROR DESCRIPTION
;
N RESULTS
S CLT=$G(CLT)
I CLT']"" S RESULTS="-1^Client variable not defined." G ACTCLTQ
;
N CLTIEN,ACT
S CLTIEN=$O(^SCTM(404.46,"B",CLT,0))
I CLTIEN="" S RESULTS="-1^Client not defined in PCMM CLIENT PATCH file." G ACTCLTQ
S ACT=$P(^SCTM(404.46,CLTIEN,0),U,2)
S RESULTS=$S(ACT:ACT,1:0) ;This was done so that a null would be zero
;
ACTCLTQ Q RESULTS
;
;
ACTSER(SER,ARY) ;
; This function call is used to return the status of a server
; or a list of active servers at the sight.
; It does not return the IENs or multiples of
; the same server value.
;
;INPUTS SER - [optional]: Test for a specific server version
; ARY - [optional]: This is the array root that the list
; is to be stored in, if SER is undefined.
; If nothing is passed then the default will be used.
; ^TMP("PCMM ACTIVE SERVERS",$J,SERVER NUMBER)=EFFECTIVE DT
;
;OUTPUTS 1 - a success
; 0 - none found.
;
N RESULTS,LP,IEN
S SER=$G(SER,"")
I SER]"" S RESULTS=$D(^SCTM(404.45,"ACT",SER))>0 G ACTSERQ
S ARY=$G(ARY,"^TMP(""PCMM ACTIVE SERVERS"",$J)")
S RESULTS=0,LP=""
;
I $O(^SCTM(404.45,"ACT",""))']"" G ACTSERQ
;
F S LP=$O(^SCTM(404.45,"ACT",LP)) Q:LP="" S IEN=$O(^SCTM(404.45,"ACT",LP,"")) Q:IEN="" DO
.S IEN=$G(^SCTM(404.45,IEN,0))
.Q:IEN=""
.S @ARY@(LP)=$P(IEN,U,3)
.S RESULTS=1
.Q
I SER]"" S RESULTS=$D(@ARY@(SER))
;
ACTSERQ Q RESULTS
;
;
DISCLNTS() ;This function call is used to determine if all clients should
;be disabled.
;
;INPUTS -- NONE
;OUTPUTS -- 1 means YES disable all clients
; 0 means NO
;
N IEN,RESULTS
S RESULTS=0
;
S IEN=+$O(^SCTM(404.44,0))
I 'IEN G DISQ
S IEN=$G(^SCTM(404.44,IEN,1))
S RESULTS=$S('$P(IEN,U,2):0,1:1)
;
DISQ Q RESULTS
;
UPCLNLST(SCX) ;update 404.46/404.45 with new client/server pair (if enabled)
; input := SCX p1[required] : ServerPatch
; p2[required] : ^ClientVersion
; p3[optional] : ^EnabledOverride(1=bypass,0=no[default])
; p4[optional] : ^ActiveServer(1=yes[default],0=no)
; p5[optional] : ^ActiveClient(1=yes[default],0=no)
; output := SCRESULT : 1 = success
; : 0 = failure/not allowed
;
N SCRESULT,SCSER,SCCLI,SCASER,SCACLI,SCBYPASS,SCIEN
S SCRESULT=0
;
; parse
S SCSER=$P(SCX,U)
I SCSER']"" G UPCLNQ
S SCCLI=$P(SCX,U,2)
I SCCLI']"" G UPCLNQ
S SCBYPASS=$P(SCX,U,3)
S SCBYPASS=$S(SCBYPASS=1:1,1:0)
S SCIEN=+$O(^SCTM(404.44,0))
I 'SCIEN G UPCLNQ
I 'SCBYPASS,$P($G(^SCTM(404.44,SCIEN,1)),U,3)=1 G UPCLNQ
S SCASER=$P(SCX,U,4)
S SCASER=$S(SCASER=0:0,1:1)
S SCACLI=$P(SCX,U,5)
S SCACLI=$S(SCACLI=0:0,1:1)
;
;update client file
N SC1,SC1IEN,SC1ERR
S SC1(1,404.46,"?+1,",.01)=SCCLI ;client version
S SC1(1,404.46,"?+1,",.02)=SCACLI ;active?
S SC1(1,404.46,"?+1,",.03)=DT ;today
D UPDATE^DIE("","SC1(1)","SC1IEN","SC1ERR")
I $D(SC1ERR)!(+$G(SC1IEN(1))<0) G UPCLNQ
;
;update server file
N SC2,SC2IEN,SC2ERR
S SC2(1,404.45,"?+1,",.01)=SCSER ;server version
S SC2(1,404.45,"?+1,",.02)=SC1IEN(1) ;ptr - client version
S SC2(1,404.45,"?+1,",.03)=DT ;today
S SC2(1,404.45,"?+1,",.04)=SCASER ;active?
D UPDATE^DIE("","SC2(1)","SC2IEN","SC2ERR")
I $D(SC2ERR)!(+$G(SC2IEN(1))<0) G UPCLNQ
S SCRESULT=1
;
UPCLNQ Q SCRESULT
;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HSCMCUT 6288 printed Sep 23, 2025@20:18:04 Page 2
SCMCUT ;ALB/JLU;General utility routine;8/17/99@1515
+1 ;;5.3;Scheduling;**177,205,204**;AUG 13, 1993
+2 ;
+3 ;This is a general utility routine for the PCMM application. Any
+4 ;general purpose utility should be placed in this routine.
+5 ;
+6 ;
CLNLST(SER,ARY,ACT) ;
+1 ;This API is a function that returns the list of clients that
+2 ;can run with the server that is passed in.
+3 ;
+4 ;INPUTs: SER --- This is the server to check for. It needs to be in
+5 ; a patch format Ex. SD*5.3*177
+6 ; ARY --- This is the array root the list will be returned in.
+7 ; If nothing is passed in a default will be used. This
+8 ; array must be clean before it is passed to this API.
+9 ; No kills will be issued.
+10 ; Ex. ^TMP("PCMM CLIENT LIST",$J,"1.2.0.0")=effective dt
+11 ; ^TMP("PCMM CLIENT LIST",$J,"1.3.0.0")=effective dt
+12 ; ACT --- This variable indicates whether to:
+13 ; 1 - return only active clients (default)
+14 ; 0 - return all clients
+15 ;
+16 ;OUTPUTS --- The output of this function call is the data in the array
+17 ; variable but also the function itself. It will either be
+18 ; 1 for a success or -1 with an error message.
+19 ; Ex. "-1^not a valid server name"
+20 ; "1"
+21 ;
+22 NEW RESULTS
+23 ;
+24 ;checking input parameters
+25 SET SER=$GET(SER)
+26 IF SER']""
SET RESULTS="-1^Server variable not defined."
GOTO CLNLSTQ
+27 SET ARY=$GET(ARY)
+28 IF ARY']""
SET ARY=$NAME(^TMP("PCMM CLIENT LIST",$JOB))
+29 SET ACT=$GET(ACT,1)
+30 ;
+31 ;checking existance of server in PCMM SERVER PATCH file.
+32 IF '$DATA(^SCTM(404.45,"B",SER))
SET RESULTS="-1^This server is not in the PCMM SERVER PATCH file."
GOTO CLNLSTQ
+33 ;
+34 ;if ACT, checking if server is active
+35 IF ACT
IF '$$ACTSER(SER)
SET RESULTS="-1^This server is not active."
GOTO CLNLSTQ
+36 ;
+37 ;loop through the server patches and build the list of clients.
+38 NEW CLT,SERIEN
+39 SET CLT=""
SET RESULTS="-1^No clients found for this Server."
+40 ;
+41 FOR
SET CLT=$ORDER(^SCTM(404.45,"ASER",SER,CLT))
if CLT=""
QUIT
SET SERIEN=$ORDER(^SCTM(404.45,"ASER",SER,CLT,""))
if SERIEN=""
QUIT
Begin DoDot:1
+42 NEW NOD5,NOD6
+43 SET NOD5=$GET(^SCTM(404.45,SERIEN,0))
+44 if NOD5=""
QUIT
+45 SET NOD6=$GET(^SCTM(404.46,$PIECE(NOD5,U,2),0))
+46 if NOD6=""
QUIT
+47 IF ACT
IF $PIECE(NOD6,U,2)
IF $DATA(^SCTM(404.45,"ACT",SER,SERIEN))
SET @ARY@($PIECE(NOD6,U,1))=$PIECE(NOD6,U,2,3)
SET RESULTS=1
+48 IF 'ACT
SET @ARY@($PIECE(NOD6,U,1))=$PIECE(NOD6,U,2,3)
SET RESULTS=1
+49 QUIT
End DoDot:1
+50 ;
CLNLSTQ QUIT RESULTS
+1 ;
+2 ;
ACTCLT(CLT) ;Is this client active?
+1 ;This function call returns whether the client passed in is active or
+2 ;not . It just tells the status of the client per its entry in PCMM
+3 ;CLIENT PATCH file. It does not relate in anyway to the PCMM SERVER
+4 ;PATCH file.
+5 ;
+6 ;INPUT: CLT - This is the External Client version number
+7 ;
+8 ;OUTPUT: 1 - ACTIVE
+9 ; 0 - NOT ACTIVE
+10 ; -1^ERROR DESCRIPTION
+11 ;
+12 NEW RESULTS
+13 SET CLT=$GET(CLT)
+14 IF CLT']""
SET RESULTS="-1^Client variable not defined."
GOTO ACTCLTQ
+15 ;
+16 NEW CLTIEN,ACT
+17 SET CLTIEN=$ORDER(^SCTM(404.46,"B",CLT,0))
+18 IF CLTIEN=""
SET RESULTS="-1^Client not defined in PCMM CLIENT PATCH file."
GOTO ACTCLTQ
+19 SET ACT=$PIECE(^SCTM(404.46,CLTIEN,0),U,2)
+20 ;This was done so that a null would be zero
SET RESULTS=$SELECT(ACT:ACT,1:0)
+21 ;
ACTCLTQ QUIT RESULTS
+1 ;
+2 ;
ACTSER(SER,ARY) ;
+1 ; This function call is used to return the status of a server
+2 ; or a list of active servers at the sight.
+3 ; It does not return the IENs or multiples of
+4 ; the same server value.
+5 ;
+6 ;INPUTS SER - [optional]: Test for a specific server version
+7 ; ARY - [optional]: This is the array root that the list
+8 ; is to be stored in, if SER is undefined.
+9 ; If nothing is passed then the default will be used.
+10 ; ^TMP("PCMM ACTIVE SERVERS",$J,SERVER NUMBER)=EFFECTIVE DT
+11 ;
+12 ;OUTPUTS 1 - a success
+13 ; 0 - none found.
+14 ;
+15 NEW RESULTS,LP,IEN
+16 SET SER=$GET(SER,"")
+17 IF SER]""
SET RESULTS=$DATA(^SCTM(404.45,"ACT",SER))>0
GOTO ACTSERQ
+18 SET ARY=$GET(ARY,"^TMP(""PCMM ACTIVE SERVERS"",$J)")
+19 SET RESULTS=0
SET LP=""
+20 ;
+21 IF $ORDER(^SCTM(404.45,"ACT",""))']""
GOTO ACTSERQ
+22 ;
+23 FOR
SET LP=$ORDER(^SCTM(404.45,"ACT",LP))
if LP=""
QUIT
SET IEN=$ORDER(^SCTM(404.45,"ACT",LP,""))
if IEN=""
QUIT
Begin DoDot:1
+24 SET IEN=$GET(^SCTM(404.45,IEN,0))
+25 if IEN=""
QUIT
+26 SET @ARY@(LP)=$PIECE(IEN,U,3)
+27 SET RESULTS=1
+28 QUIT
End DoDot:1
+29 IF SER]""
SET RESULTS=$DATA(@ARY@(SER))
+30 ;
ACTSERQ QUIT RESULTS
+1 ;
+2 ;
DISCLNTS() ;This function call is used to determine if all clients should
+1 ;be disabled.
+2 ;
+3 ;INPUTS -- NONE
+4 ;OUTPUTS -- 1 means YES disable all clients
+5 ; 0 means NO
+6 ;
+7 NEW IEN,RESULTS
+8 SET RESULTS=0
+9 ;
+10 SET IEN=+$ORDER(^SCTM(404.44,0))
+11 IF 'IEN
GOTO DISQ
+12 SET IEN=$GET(^SCTM(404.44,IEN,1))
+13 SET RESULTS=$SELECT('$PIECE(IEN,U,2):0,1:1)
+14 ;
DISQ QUIT RESULTS
+1 ;
UPCLNLST(SCX) ;update 404.46/404.45 with new client/server pair (if enabled)
+1 ; input := SCX p1[required] : ServerPatch
+2 ; p2[required] : ^ClientVersion
+3 ; p3[optional] : ^EnabledOverride(1=bypass,0=no[default])
+4 ; p4[optional] : ^ActiveServer(1=yes[default],0=no)
+5 ; p5[optional] : ^ActiveClient(1=yes[default],0=no)
+6 ; output := SCRESULT : 1 = success
+7 ; : 0 = failure/not allowed
+8 ;
+9 NEW SCRESULT,SCSER,SCCLI,SCASER,SCACLI,SCBYPASS,SCIEN
+10 SET SCRESULT=0
+11 ;
+12 ; parse
+13 SET SCSER=$PIECE(SCX,U)
+14 IF SCSER']""
GOTO UPCLNQ
+15 SET SCCLI=$PIECE(SCX,U,2)
+16 IF SCCLI']""
GOTO UPCLNQ
+17 SET SCBYPASS=$PIECE(SCX,U,3)
+18 SET SCBYPASS=$SELECT(SCBYPASS=1:1,1:0)
+19 SET SCIEN=+$ORDER(^SCTM(404.44,0))
+20 IF 'SCIEN
GOTO UPCLNQ
+21 IF 'SCBYPASS
IF $PIECE($GET(^SCTM(404.44,SCIEN,1)),U,3)=1
GOTO UPCLNQ
+22 SET SCASER=$PIECE(SCX,U,4)
+23 SET SCASER=$SELECT(SCASER=0:0,1:1)
+24 SET SCACLI=$PIECE(SCX,U,5)
+25 SET SCACLI=$SELECT(SCACLI=0:0,1:1)
+26 ;
+27 ;update client file
+28 NEW SC1,SC1IEN,SC1ERR
+29 ;client version
SET SC1(1,404.46,"?+1,",.01)=SCCLI
+30 ;active?
SET SC1(1,404.46,"?+1,",.02)=SCACLI
+31 ;today
SET SC1(1,404.46,"?+1,",.03)=DT
+32 DO UPDATE^DIE("","SC1(1)","SC1IEN","SC1ERR")
+33 IF $DATA(SC1ERR)!(+$GET(SC1IEN(1))<0)
GOTO UPCLNQ
+34 ;
+35 ;update server file
+36 NEW SC2,SC2IEN,SC2ERR
+37 ;server version
SET SC2(1,404.45,"?+1,",.01)=SCSER
+38 ;ptr - client version
SET SC2(1,404.45,"?+1,",.02)=SC1IEN(1)
+39 ;today
SET SC2(1,404.45,"?+1,",.03)=DT
+40 ;active?
SET SC2(1,404.45,"?+1,",.04)=SCASER
+41 DO UPDATE^DIE("","SC2(1)","SC2IEN","SC2ERR")
+42 IF $DATA(SC2ERR)!(+$GET(SC2IEN(1))<0)
GOTO UPCLNQ
+43 SET SCRESULT=1
+44 ;
UPCLNQ QUIT SCRESULT
+1 ;
