[613] | 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
|
---|