SDECNEW.m

SDECNEW ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 ;

 Q

 ;

 ;

 ;  PROGRAMMERS:  DO NOT USE THE FIRST LINE FOR ENTRY.

 ;                USE LABEL EN^XBNEW() FOR ENTRY.

 ;

 ; EN^XBNEW("TAG^ROUTINE","variable list")

 ;

 ; Variable list has the form "AGDFN;AGINS;AGP*".

 ; Wild card * allowed.

 ;

 ; XBRET has the form "TAG^ROUTINE:VAR;NSVAR*"

 ;

 ; This allows for the nesting of die calls by

 ;

 ; 1. Building and executing an exclusive new from preselected

 ;    kernel variables and any local variables &/or name

 ;    spaces identified by the calling parameter.

 ;

 ; 2. After executing the new (....) XBNEW performs a DO call

 ;    to the program entry point identified by the calling

 ;    parameter.  The entry point passed should build the

 ;    variables and execute the DIE call to be nested.

 ;

 ; 3. As XBNEW quits to return to the calling program it pops

 ;    the variable stack.

 ;

 ;

 NEW XB,XBNS,XBN,XB,XBY,XBL,XBKVAR

 G S

 ;

EN(XBRT,XBNS) ;PEP XBRT=TAG^ROUTINE  XBNS=variable list ";" with * allowed

 NEW XB,XBN,XB,XBY,XBL,XBKVAR,XBRET

 S XBRET=XBRT_":"_XBNS

S ;

 N XBI

 I XBRET'[":" S XBRET=XBRET_":"

 S XBN="XBRET",XBKVAR=$P($T(XBKVAR),";;",2),XBNS=$P(XBRET,":",2)

 I XBNS="" G RETURN

 F XBI=1:1 S (XB,XBY)=$P(XBNS,";",XBI) Q:XB=""  D

 . I XB'["*" S XBN=XBN_","_XB Q

 . S (XB,XBY)=$P(XB,"*"),XBN=XBN_","_XB,XBL=$L(XB)

 . F  S XBY=$O(@XBY) Q:((XBY="")!(XB'=$E(XBY,1,XBL)))  S XBN=XBN_","_XBY

 .Q

RETURN ;

 S XBN="("_XBN_","_XBKVAR_")",$P(XBRET,":",2)=XBN

NEW ;

 NEW @($P(XBRET,":",2))

 D @($P(XBRET,":",1))

 Q

 ;

END ;--------------------------------------------------------------

 ; the following taken from the variable list in KILL^XUSCLEAN from  KERNEL

XBKVAR ;;DUZ,DTIME,DT,DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,%ZH0,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ,XQORS;; IHS/SET/GTH XB*3*9 10/29/2002

 ;;DUZ,DTIME,DT,DISYS,IO,IOF,IOBS,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,ZTSTOP,ZTQUEUED,ZTREQ

 ;--------------------------------------------------------------

 Q

 ;

--- Routine Detail   --- with STRUCTURED ROUTINE LISTING ---SDECNEW   2143     printed  Mar 13, 2025@21:57:18                                                                                                                                                                                                     Page 2

SDECNEW   ;ALB/SAT - VISTA SCHEDULING RPCS ;JAN 15, 2016

 +1       ;;5.3;Scheduling;**627**;Aug 13, 1993;Build 249

 +2       ;

 +3        QUIT 

 +4       ;

 +5       ;

 +6       ;  PROGRAMMERS:  DO NOT USE THE FIRST LINE FOR ENTRY.

 +7       ;                USE LABEL EN^XBNEW() FOR ENTRY.

 +8       ;

 +9       ; EN^XBNEW("TAG^ROUTINE","variable list")

 +10      ;

 +11      ; Variable list has the form "AGDFN;AGINS;AGP*".

 +12      ; Wild card * allowed.

 +13      ;

 +14      ; XBRET has the form "TAG^ROUTINE:VAR;NSVAR*"

 +15      ;

 +16      ; This allows for the nesting of die calls by

 +17      ;

 +18      ; 1. Building and executing an exclusive new from preselected

 +19      ;    kernel variables and any local variables &/or name

 +20      ;    spaces identified by the calling parameter.

 +21      ;

 +22      ; 2. After executing the new (....) XBNEW performs a DO call

 +23      ;    to the program entry point identified by the calling

 +24      ;    parameter.  The entry point passed should build the

 +25      ;    variables and execute the DIE call to be nested.

 +26      ;

 +27      ; 3. As XBNEW quits to return to the calling program it pops

 +28      ;    the variable stack.

 +29      ;

 +30      ;

 +31       NEW XB,XBNS,XBN,XB,XBY,XBL,XBKVAR

 +32       GOTO S

 +33      ;

EN(XBRT,XBNS) ;PEP XBRT=TAG^ROUTINE  XBNS=variable list ";" with * allowed

 +1        NEW XB,XBN,XB,XBY,XBL,XBKVAR,XBRET

 +2        SET XBRET=XBRT_":"_XBNS

S         ;

 +1        NEW XBI

 +2        IF XBRET'[":"

               SET XBRET=XBRET_":"

 +3        SET XBN="XBRET"

           SET XBKVAR=$PIECE($TEXT(XBKVAR),";;",2)

           SET XBNS=$PIECE(XBRET,":",2)

 +4        IF XBNS=""

               GOTO RETURN

 +5        FOR XBI=1:1

               SET (XB,XBY)=$PIECE(XBNS,";",XBI)

               if XB=""

                   QUIT 

               Begin DoDot:1

 +6                IF XB'["*"

                       SET XBN=XBN_","_XB

                       QUIT 

 +7                SET (XB,XBY)=$PIECE(XB,"*")

                   SET XBN=XBN_","_XB

                   SET XBL=$LENGTH(XB)

 +8                FOR 

                       SET XBY=$ORDER(@XBY)

                       if ((XBY="")!(XB'=$EXTRACT(XBY,1,XBL)))

                           QUIT 

                       SET XBN=XBN_","_XBY

 +9                QUIT 

               End DoDot:1

RETURN    ;

 +1        SET XBN="("_XBN_","_XBKVAR_")"

           SET $PIECE(XBRET,":",2)=XBN

NEW       ;

 +1        NEW @($PIECE(XBRET,":",2))

 +2        DO @($PIECE(XBRET,":",1))

 +3        QUIT 

 +4       ;

END       ;--------------------------------------------------------------

 +1       ; the following taken from the variable list in KILL^XUSCLEAN from  KERNEL

XBKVAR    ;;DUZ,DTIME,DT,DISYS,IO,IOBS,IOF,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,%ZH0,XQVOL,XQY,XQY0,XQDIC,XQPSM,XQPT,XQAUDIT,XQXFLG,ZTSTOP,ZTQUEUED,ZTREQ,XQORS;; IHS/SET/GTH XB*3*9 10/29/2002

 +1       ;;DUZ,DTIME,DT,DISYS,IO,IOF,IOBS,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,ZTSTOP,ZTQUEUED,ZTREQ

 +2       ;--------------------------------------------------------------

 +3        QUIT 

 +4       ;