- 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 Feb 19, 2025@00:03:59 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
