[641] | 1 | XBDIE(XBRET) ; IHS/ADC/GTH - NESTING OF DIE ; [ 02/07/97 3:02 PM ]
|
---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
---|
| 3 | ;
|
---|
| 4 | ; Thanks to Paul Wesley, DSD, for providing the original
|
---|
| 5 | ; routine.
|
---|
| 6 | ;
|
---|
| 7 | ; PROGRAMMERS NOTE: PLEASE USE THE MORE GENERIC ^XBNEW.
|
---|
| 8 | ;
|
---|
| 9 | ; XBRET has the form "TAG^ROUTINE:VAR,NSVAR*"
|
---|
| 10 | ; This allows for the nesting of die calls by
|
---|
| 11 | ;
|
---|
| 12 | ; 1. Building and executing an exclusive new from preselected
|
---|
| 13 | ; kernel variables and any local variables &/or name
|
---|
| 14 | ; spaces identified by the calling parameter.
|
---|
| 15 | ; 2. After executing the new (....) XBDIE performs a DO call
|
---|
| 16 | ; to the program entry point identified by the calling
|
---|
| 17 | ; parameter. The entry point passed should build the
|
---|
| 18 | ; variables and execute the DIE call to be nested.
|
---|
| 19 | ; 3. As XBDIE quits to return to the calling program it pops
|
---|
| 20 | ; the variable stack.
|
---|
| 21 | ;
|
---|
| 22 | ; The passing parameter is built by "tag^routine:var;vns*"
|
---|
| 23 | ;
|
---|
| 24 | ; The die call to be nested is structured with a tag entry
|
---|
| 25 | ; and a Quit.
|
---|
| 26 | ;
|
---|
| 27 | ; The call is made with DO ^XBDIE("TAG^ROUTINE:AGSITE,ABM*")
|
---|
| 28 | ; where the variable AGSITE and the namespace ABM is
|
---|
| 29 | ; included in the exclusive new for illustration.
|
---|
| 30 | ;
|
---|
| 31 | ; Proper logic flow after the XBDIE call usually needs some
|
---|
| 32 | ; attention.
|
---|
| 33 | ;
|
---|
| 34 | ; A TEST entry point is provided in this routine for
|
---|
| 35 | ; illustration.
|
---|
| 36 | ;
|
---|
| 37 | S ;
|
---|
| 38 | I XBRET'[":" S XBRET=XBRET_":"
|
---|
| 39 | S XBN="XBRET"
|
---|
| 40 | S XBKVAR=$P($T(XBKVAR),";;",2)
|
---|
| 41 | S XBNS=$P(XBRET,":",2)
|
---|
| 42 | I XBNS="" G RETURN
|
---|
| 43 | F XBI=1:1 S (XB,XBY)=$P(XBNS,";",XBI) Q:XB="" D
|
---|
| 44 | .I XB'["*" S XBN=XBN_","_XB Q
|
---|
| 45 | .S (XB,XBY)=$P(XB,"*")
|
---|
| 46 | .S XBN=XBN_","_XB,XBL=$L(XB)
|
---|
| 47 | .F S XBY=$O(@XBY) Q:((XBY="")!(XB'=$E(XBY,1,XBL))) S XBN=XBN_","_XBY
|
---|
| 48 | .Q
|
---|
| 49 | RETURN ;
|
---|
| 50 | S XBN="("_XBN_","_XBKVAR_")"
|
---|
| 51 | S $P(XBRET,":",2)=XBN
|
---|
| 52 | KILL XBNS,XBN,XB,XBY,XBL,XBKVAR
|
---|
| 53 | NEW @($P(XBRET,":",2))
|
---|
| 54 | D @($P(XBRET,":",1))
|
---|
| 55 | Q
|
---|
| 56 | ;
|
---|
| 57 | END ;--------------------------------------------------------------
|
---|
| 58 | XBKVAR ;;DUZ,DTIME,DT,DISYS,IO,IOF,IOBS,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,ZTSTOP,ZTQUEUED,ZTREQ
|
---|
| 59 | ;--------------------------------------------------------------
|
---|
| 60 | Q
|
---|
| 61 | ;
|
---|
| 62 | TEST ;
|
---|
| 63 | D ^XBDIE("T2^XBDIE:AG;PW")
|
---|
| 64 | Q
|
---|
| 65 | ;
|
---|
| 66 | T2 ;
|
---|
| 67 | W !,"GOT TO T2",!
|
---|
| 68 | W !,"Here is where the die call would be structured and called",!,"Following is a list of variables that were within the exclusive new",!
|
---|
| 69 | D ^XBVL
|
---|
| 70 | Q
|
---|
| 71 | ;
|
---|