RGUTRRT ;CAIRO/DKM - Remote routine transfer;04-Sep-1998 11:26;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
;=================================================================
; Utility to copy routines to all target machines. A server
; runs in the background on all machines to receive new routines.
;=================================================================
; This is the entry point for interactive use
D ENTRY(0)
Q
DELETE D ENTRY(1)
Q
ENTRY(RGDALL) ;
D HOME^%ZIS
D TITLE^RGUT("Remote Routine "_$S(RGDALL:"Delete",1:"Transfer"),"1.0")
X ^%ZOSF("RSEL")
I RGDALL D
.N RGRTN
.S RGRTN=$C(1)
.F S RGRTN=$O(^UTILITY($J,RGRTN)) Q:RGRTN="" S ^(RGRTN)="DELETE"
D SAVE
Q
; This entry point allows passing routine names in ^UTILITY
; If the data of the ^UTILITY node is "DELETE", the routine is deleted!
SAVE Q:$D(^UTILITY($J))<10
N RGRTN,RGDEL
S RGRTN=$C(1),U="^"
F S RGRTN=$O(^UTILITY($J,RGRTN)) Q:RGRTN="" D
.S RGDEL=^(RGRTN)="DELETE"
.K ^(RGRTN)
.D RRT(RGRTN,RGDEL)
D JOB
Q
; This subroutine remote copies/deletes routine RGRTN
RRT(RGRTN,RGDEL) ;
Q:RGRTN'?1.8AN!($G(^RGUTL("UCI"))="")
N RGX,RGZ,RGZ1,RGZ2
S RGDEL=+$G(RGDEL),U="^"
L +^XTMP("RGUTSRV",0)
S RGX=1+$O(^XTMP("RGUTSRV",$C(1)),-1)
F RGZ=0:0 S RGZ=+$O(^XTMP("RGUTSRV","B",RGRTN,RGZ)) Q:'RGZ K ^(RGZ),^XTMP("RGUTSRV",RGZ)
S ^XTMP("RGUTSRV",RGX)=RGRTN,^XTMP("RGUTSRV","B",RGRTN,RGX)=""
L -^XTMP("RGUTSRV",0)
X:'RGDEL "ZL "_RGRTN_" F RGZ=1:1 S RGZ1=$T(+RGZ) Q:'$L(RGZ1) S ^XTMP(""RGUTSRV"",RGX,RGZ)=RGZ1"
S RGZ2=$$UCI
F RGZ1=1:1 S RGZ=$$UCI(RGZ1) Q:'$L(RGZ) S:RGZ'=RGZ2!RGDEL ^XTMP("RGUTSRV",RGX,0,RGZ)=""
F RGZ1=1:1 S RGZ=$$UCI(RGZ1) Q:'$L(RGZ) S:RGZ'=RGZ2!RGDEL ^XTMP("RGUTSRV",RGZ,RGX)=""
Q
; Return indexed UCI
UCI(RGN) N RGZ,Y
I '$G(RGN) X ^%ZOSF("UCI") Q Y
S U="^",RGZ=$P($G(^RGUTL("UCI")),U,RGN)
I $L(RGZ),RGZ'["," S RGZ=$P($$UCI,",")_","_RGZ
Q RGZ
; Make sure all remote servers are running
JOB N RGZ,RGUCI
F RGZ=1:1 S RGUCI=$$UCI(RGZ) Q:'$L(RGUCI) D
.L +^XTMP("RGUTSRV",RGUCI):0
.E Q
.L -^XTMP("RGUTSRV",RGUCI)
.I $$QUEUE^RGUTTSK("^RGUTSRV","Remote Routine Transfer",,,,RGUCI)
Q
; Shutdown remote servers
SHUTDOWN N RGZ,RGUCI
F RGZ=1:1 S RGUCI=$$UCI(RGZ) Q:'$L(RGUCI) S ^XTMP("RGUTSRV",RGUCI,0)=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTRRT 2297 printed Apr 09, 2024@21:39:53 Page 2
RGUTRRT ;CAIRO/DKM - Remote routine transfer;04-Sep-1998 11:26;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
+2 ;=================================================================
+3 ; Utility to copy routines to all target machines. A server
+4 ; runs in the background on all machines to receive new routines.
+5 ;=================================================================
+6 ; This is the entry point for interactive use
+7 DO ENTRY(0)
+8 QUIT
DELETE DO ENTRY(1)
+1 QUIT
ENTRY(RGDALL) ;
+1 DO HOME^%ZIS
+2 DO TITLE^RGUT("Remote Routine "_$SELECT(RGDALL:"Delete",1:"Transfer"),"1.0")
+3 XECUTE ^%ZOSF("RSEL")
+4 IF RGDALL
Begin DoDot:1
+5 NEW RGRTN
+6 SET RGRTN=$CHAR(1)
+7 FOR
SET RGRTN=$ORDER(^UTILITY($JOB,RGRTN))
if RGRTN=""
QUIT
SET ^(RGRTN)="DELETE"
End DoDot:1
+8 DO SAVE
+9 QUIT
+10 ; This entry point allows passing routine names in ^UTILITY
+11 ; If the data of the ^UTILITY node is "DELETE", the routine is deleted!
SAVE if $DATA(^UTILITY($JOB))<10
QUIT
+1 NEW RGRTN,RGDEL
+2 SET RGRTN=$CHAR(1)
SET U="^"
+3 FOR
SET RGRTN=$ORDER(^UTILITY($JOB,RGRTN))
if RGRTN=""
QUIT
Begin DoDot:1
+4 SET RGDEL=^(RGRTN)="DELETE"
+5 KILL ^(RGRTN)
+6 DO RRT(RGRTN,RGDEL)
End DoDot:1
+7 DO JOB
+8 QUIT
+9 ; This subroutine remote copies/deletes routine RGRTN
RRT(RGRTN,RGDEL) ;
+1 if RGRTN'?1.8AN!($GET(^RGUTL("UCI"))="")
QUIT
+2 NEW RGX,RGZ,RGZ1,RGZ2
+3 SET RGDEL=+$GET(RGDEL)
SET U="^"
+4 LOCK +^XTMP("RGUTSRV",0)
+5 SET RGX=1+$ORDER(^XTMP("RGUTSRV",$CHAR(1)),-1)
+6 FOR RGZ=0:0
SET RGZ=+$ORDER(^XTMP("RGUTSRV","B",RGRTN,RGZ))
if 'RGZ
QUIT
KILL ^(RGZ),^XTMP("RGUTSRV",RGZ)
+7 SET ^XTMP("RGUTSRV",RGX)=RGRTN
SET ^XTMP("RGUTSRV","B",RGRTN,RGX)=""
+8 LOCK -^XTMP("RGUTSRV",0)
+9 if 'RGDEL
XECUTE "ZL "_RGRTN_" F RGZ=1:1 S RGZ1=$T(+RGZ) Q:'$L(RGZ1) S ^XTMP(""RGUTSRV"",RGX,RGZ)=RGZ1"
+10 SET RGZ2=$$UCI
+11 FOR RGZ1=1:1
SET RGZ=$$UCI(RGZ1)
if '$LENGTH(RGZ)
QUIT
if RGZ'=RGZ2!RGDEL
SET ^XTMP("RGUTSRV",RGX,0,RGZ)=""
+12 FOR RGZ1=1:1
SET RGZ=$$UCI(RGZ1)
if '$LENGTH(RGZ)
QUIT
if RGZ'=RGZ2!RGDEL
SET ^XTMP("RGUTSRV",RGZ,RGX)=""
+13 QUIT
+14 ; Return indexed UCI
UCI(RGN) NEW RGZ,Y
+1 IF '$GET(RGN)
XECUTE ^%ZOSF("UCI")
QUIT Y
+2 SET U="^"
SET RGZ=$PIECE($GET(^RGUTL("UCI")),U,RGN)
+3 IF $LENGTH(RGZ)
IF RGZ'[","
SET RGZ=$PIECE($$UCI,",")_","_RGZ
+4 QUIT RGZ
+5 ; Make sure all remote servers are running
JOB NEW RGZ,RGUCI
+1 FOR RGZ=1:1
SET RGUCI=$$UCI(RGZ)
if '$LENGTH(RGUCI)
QUIT
Begin DoDot:1
+2 LOCK +^XTMP("RGUTSRV",RGUCI):0
+3 IF '$TEST
QUIT
+4 LOCK -^XTMP("RGUTSRV",RGUCI)
+5 IF $$QUEUE^RGUTTSK("^RGUTSRV","Remote Routine Transfer",,,,RGUCI)
End DoDot:1
+6 QUIT
+7 ; Shutdown remote servers
SHUTDOWN NEW RGZ,RGUCI
+1 FOR RGZ=1:1
SET RGUCI=$$UCI(RGZ)
if '$LENGTH(RGUCI)
QUIT
SET ^XTMP("RGUTSRV",RGUCI,0)=1
+2 QUIT
