1 | RGUTRRT ;CAIRO/DKM - Remote routine transfer;04-Sep-1998 11:26;DKM
|
---|
2 | ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
|
---|
3 | ;=================================================================
|
---|
4 | ; Utility to copy routines to all target machines. A server
|
---|
5 | ; runs in the background on all machines to receive new routines.
|
---|
6 | ;=================================================================
|
---|
7 | ; This is the entry point for interactive use
|
---|
8 | D ENTRY(0)
|
---|
9 | Q
|
---|
10 | DELETE D ENTRY(1)
|
---|
11 | Q
|
---|
12 | ENTRY(RGDALL) ;
|
---|
13 | D HOME^%ZIS
|
---|
14 | D TITLE^RGUT("Remote Routine "_$S(RGDALL:"Delete",1:"Transfer"),"1.0")
|
---|
15 | X ^%ZOSF("RSEL")
|
---|
16 | I RGDALL D
|
---|
17 | .N RGRTN
|
---|
18 | .S RGRTN=$C(1)
|
---|
19 | .F S RGRTN=$O(^UTILITY($J,RGRTN)) Q:RGRTN="" S ^(RGRTN)="DELETE"
|
---|
20 | D SAVE
|
---|
21 | Q
|
---|
22 | ; This entry point allows passing routine names in ^UTILITY
|
---|
23 | ; If the data of the ^UTILITY node is "DELETE", the routine is deleted!
|
---|
24 | SAVE Q:$D(^UTILITY($J))<10
|
---|
25 | N RGRTN,RGDEL
|
---|
26 | S RGRTN=$C(1),U="^"
|
---|
27 | F S RGRTN=$O(^UTILITY($J,RGRTN)) Q:RGRTN="" D
|
---|
28 | .S RGDEL=^(RGRTN)="DELETE"
|
---|
29 | .K ^(RGRTN)
|
---|
30 | .D RRT(RGRTN,RGDEL)
|
---|
31 | D JOB
|
---|
32 | Q
|
---|
33 | ; This subroutine remote copies/deletes routine RGRTN
|
---|
34 | RRT(RGRTN,RGDEL) ;
|
---|
35 | Q:RGRTN'?1.8AN!($G(^RGUTL("UCI"))="")
|
---|
36 | N RGX,RGZ,RGZ1,RGZ2
|
---|
37 | S RGDEL=+$G(RGDEL),U="^"
|
---|
38 | L +^XTMP("RGUTSRV",0)
|
---|
39 | S RGX=1+$O(^XTMP("RGUTSRV",$C(1)),-1)
|
---|
40 | F RGZ=0:0 S RGZ=+$O(^XTMP("RGUTSRV","B",RGRTN,RGZ)) Q:'RGZ K ^(RGZ),^XTMP("RGUTSRV",RGZ)
|
---|
41 | S ^XTMP("RGUTSRV",RGX)=RGRTN,^XTMP("RGUTSRV","B",RGRTN,RGX)=""
|
---|
42 | L -^XTMP("RGUTSRV",0)
|
---|
43 | X:'RGDEL "ZL "_RGRTN_" F RGZ=1:1 S RGZ1=$T(+RGZ) Q:'$L(RGZ1) S ^XTMP(""RGUTSRV"",RGX,RGZ)=RGZ1"
|
---|
44 | S RGZ2=$$UCI
|
---|
45 | F RGZ1=1:1 S RGZ=$$UCI(RGZ1) Q:'$L(RGZ) S:RGZ'=RGZ2!RGDEL ^XTMP("RGUTSRV",RGX,0,RGZ)=""
|
---|
46 | F RGZ1=1:1 S RGZ=$$UCI(RGZ1) Q:'$L(RGZ) S:RGZ'=RGZ2!RGDEL ^XTMP("RGUTSRV",RGZ,RGX)=""
|
---|
47 | Q
|
---|
48 | ; Return indexed UCI
|
---|
49 | UCI(RGN) N RGZ,Y
|
---|
50 | I '$G(RGN) X ^%ZOSF("UCI") Q Y
|
---|
51 | S U="^",RGZ=$P($G(^RGUTL("UCI")),U,RGN)
|
---|
52 | I $L(RGZ),RGZ'["," S RGZ=$P($$UCI,",")_","_RGZ
|
---|
53 | Q RGZ
|
---|
54 | ; Make sure all remote servers are running
|
---|
55 | JOB N RGZ,RGUCI
|
---|
56 | F RGZ=1:1 S RGUCI=$$UCI(RGZ) Q:'$L(RGUCI) D
|
---|
57 | .L +^XTMP("RGUTSRV",RGUCI):0
|
---|
58 | .E Q
|
---|
59 | .L -^XTMP("RGUTSRV",RGUCI)
|
---|
60 | .I $$QUEUE^RGUTTSK("^RGUTSRV","Remote Routine Transfer",,,,RGUCI)
|
---|
61 | Q
|
---|
62 | ; Shutdown remote servers
|
---|
63 | SHUTDOWN N RGZ,RGUCI
|
---|
64 | F RGZ=1:1 S RGUCI=$$UCI(RGZ) Q:'$L(RGUCI) S ^XTMP("RGUTSRV",RGUCI,0)=1
|
---|
65 | Q
|
---|