RGUTSRV ;CAIRO/DKM - Server for remote routine utilities;09-Sep-1998 08:31;DKM
;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
;=================================================================
N RGUCI,RGX,RGRTN,RGZ,X
S RGUCI=$$UCI^RGUTRRT
L +^XTMP("RGUTSRV",RGUCI):0
E Q
I $$NEWERR^%ZTER N $ET S $ET=""
S X=10
X ^%ZOSF("MAXSIZ")
F D I $G(^XTMP("RGUTSRV",RGUCI,0)) K ^(0) Q
.F RGX=0:0 S RGX=+$O(^XTMP("RGUTSRV",RGUCI,RGX)) Q:'RGX D
..S @$$TRAP^RGZOSF("ERR^RGUTSRV")
..S RGRTN=$G(^XTMP("RGUTSRV",RGX))
..I RGRTN'="" D
...X "ZR F RGZ=0:0 S RGZ=$O(^XTMP(""RGUTSRV"",RGX,RGZ)) ZI:RGZ ^(RGZ) I 'RGZ ZS "_RGRTN_" Q"
...K ^XTMP("RGUTSRV",RGX,0,RGUCI)
...K:'$D(^XTMP("RGUTSRV",RGX,0)) ^XTMP("RGUTSRV",RGX),^XTMP("RGUTSRV","B",RGRTN,RGX)
..K ^XTMP("RGUTSRV",RGUCI,RGX)
.H 5
L -^XTMP("RGUTSRV",RGUCI)
Q
ERR S ^XTMP("RGUTSRV",RGX,0,RGUCI)=$$EC^%ZOSV
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGUTSRV 881 printed Dec 13, 2024@02:37:29 Page 2
RGUTSRV ;CAIRO/DKM - Server for remote routine utilities;09-Sep-1998 08:31;DKM
+1 ;;2.1;RUN TIME LIBRARY;;Mar 22, 1999
+2 ;=================================================================
+3 NEW RGUCI,RGX,RGRTN,RGZ,X
+4 SET RGUCI=$$UCI^RGUTRRT
+5 LOCK +^XTMP("RGUTSRV",RGUCI):0
+6 IF '$TEST
QUIT
+7 IF $$NEWERR^%ZTER
NEW $ETRAP
SET $ETRAP=""
+8 SET X=10
+9 XECUTE ^%ZOSF("MAXSIZ")
+10 FOR
Begin DoDot:1
+11 FOR RGX=0:0
SET RGX=+$ORDER(^XTMP("RGUTSRV",RGUCI,RGX))
if 'RGX
QUIT
Begin DoDot:2
+12 SET @$$TRAP^RGZOSF("ERR^RGUTSRV")
+13 SET RGRTN=$GET(^XTMP("RGUTSRV",RGX))
+14 IF RGRTN'=""
Begin DoDot:3
+15 XECUTE "ZR F RGZ=0:0 S RGZ=$O(^XTMP(""RGUTSRV"",RGX,RGZ)) ZI:RGZ ^(RGZ) I 'RGZ ZS "_RGRTN_" Q"
+16 KILL ^XTMP("RGUTSRV",RGX,0,RGUCI)
+17 if '$DATA(^XTMP("RGUTSRV",RGX,0))
KILL ^XTMP("RGUTSRV",RGX),^XTMP("RGUTSRV","B",RGRTN,RGX)
End DoDot:3
+18 KILL ^XTMP("RGUTSRV",RGUCI,RGX)
End DoDot:2
+19 HANG 5
End DoDot:1
IF $GET(^XTMP("RGUTSRV",RGUCI,0))
KILL ^(0)
QUIT
+20 LOCK -^XTMP("RGUTSRV",RGUCI)
+21 QUIT
ERR SET ^XTMP("RGUTSRV",RGX,0,RGUCI)=$$EC^%ZOSV
+1 QUIT
