| 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 | 
|---|