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