RGUTSRV.m

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 ---RGUTSRV   881     printed  Feb 19, 2025@00:04                                                                                                                                                                                                         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