| 1 | XBNEW(XBRET) ; IHS/ADC/GTH - NESTING OF DIE ; [ 10/29/2002 7:42 AM ]
|
|---|
| 2 | ;;4.0;XB;;Jul 20, 2009;Build 2
|
|---|
| 3 | ; XB*3*9 IHS/SET/GTH XB*3*9 10/29/2002 Unwinder problem with NEW'ing
|
|---|
| 4 | ;
|
|---|
| 5 | ; PROGRAMMERS: DO NOT USE THE FIRST LINE FOR ENTRY.
|
|---|
| 6 | ; USE LABEL EN^XBNEW() FOR ENTRY.
|
|---|
| 7 | ;
|
|---|
| 8 | ; EN^XBNEW("TAG^ROUTINE","variable list")
|
|---|
| 9 | ;
|
|---|
| 10 | ; Variable list has the form "AGDFN;AGINS;AGP*".
|
|---|
| 11 | ; Wild card * allowed.
|
|---|
| 12 | ;
|
|---|
| 13 | ; XBRET has the form "TAG^ROUTINE:VAR;NSVAR*"
|
|---|
| 14 | ;
|
|---|
| 15 | ; This allows for the nesting of die calls by
|
|---|
| 16 | ;
|
|---|
| 17 | ; 1. Building and executing an exclusive new from preselected
|
|---|
| 18 | ; kernel variables and any local variables &/or name
|
|---|
| 19 | ; spaces identified by the calling parameter.
|
|---|
| 20 | ;
|
|---|
| 21 | ; 2. After executing the new (....) XBNEW performs a DO call
|
|---|
| 22 | ; to the program entry point identified by the calling
|
|---|
| 23 | ; parameter. The entry point passed should build the
|
|---|
| 24 | ; variables and execute the DIE call to be nested.
|
|---|
| 25 | ;
|
|---|
| 26 | ; 3. As XBNEW quits to return to the calling program it pops
|
|---|
| 27 | ; the variable stack.
|
|---|
| 28 | ;
|
|---|
| 29 | ;
|
|---|
| 30 | NEW XB,XBNS,XBN,XB,XBY,XBL,XBKVAR
|
|---|
| 31 | G S
|
|---|
| 32 | ;
|
|---|
| 33 | EN(XBRT,XBNS) ;PEP XBRT=TAG^ROUTINE XBNS=varialbe list ";" with * allowed
|
|---|
| 34 | NEW XB,XBN,XB,XBY,XBL,XBKVAR,XBRET
|
|---|
| 35 | S XBRET=XBRT_":"_XBNS
|
|---|
| 36 | S ;
|
|---|
| 37 | I XBRET'[":" S XBRET=XBRET_":"
|
|---|
| 38 | S XBN="XBRET",XBKVAR=$P($T(XBKVAR),";;",2),XBNS=$P(XBRET,":",2)
|
|---|
| 39 | I XBNS="" G RETURN
|
|---|
| 40 | F XBI=1:1 S (XB,XBY)=$P(XBNS,";",XBI) Q:XB="" D
|
|---|
| 41 | . I XB'["*" S XBN=XBN_","_XB Q
|
|---|
| 42 | . S (XB,XBY)=$P(XB,"*"),XBN=XBN_","_XB,XBL=$L(XB)
|
|---|
| 43 | . F S XBY=$O(@XBY) Q:((XBY="")!(XB'=$E(XBY,1,XBL))) S XBN=XBN_","_XBY
|
|---|
| 44 | .Q
|
|---|
| 45 | RETURN ;
|
|---|
| 46 | S XBN="("_XBN_","_XBKVAR_")",$P(XBRET,":",2)=XBN
|
|---|
| 47 | NEW ;
|
|---|
| 48 | NEW @($P(XBRET,":",2))
|
|---|
| 49 | D @($P(XBRET,":",1))
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | END ;--------------------------------------------------------------
|
|---|
| 53 | ; the following taken from the variable list in KILL^XUSCLEAN from KERNEL
|
|---|
| 54 | 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
|
|---|
| 55 | ;;DUZ,DTIME,DT,DISYS,IO,IOF,IOBS,IOM,ION,IOSL,IOST,IOT,IOS,IOXY,U,XRTL,ZTSTOP,ZTQUEUED,ZTREQ ; IHS/SET/GTH XB*3*9 10/29/2002
|
|---|
| 56 | ;--------------------------------------------------------------
|
|---|
| 57 | Q
|
|---|
| 58 | ;
|
|---|
