25 lines
949 B
Mathematica
25 lines
949 B
Mathematica
|
XBXTSS ;OHPRD-TUCSON/BRJ;EXTRACT AND TABLE SUBSCRIPTS
|
||
|
|
;;4.0;XB;;Jul 20, 2009;Build 2
|
||
|
|
; X=SUBSCRIPT LIST ENCLOSED IN PARENTHESES PASSED BY CALLER
|
||
|
|
; Y IS RETURNED AS:
|
||
|
|
; Y=0 X VALUE NOT A PROPER SUBSCRIPT FORMAT
|
||
|
|
; OR (SOME KIND OF ERROR ENCOUNTERED)
|
||
|
|
; Y=n n=NUMBER OF SUBSCRIPTS IN X
|
||
|
|
; Y(n)=value ARRAY OF SUBSCRIPTS
|
||
|
|
; n=SUBSCRIPT POSITION
|
||
|
|
; value=SUBSCRIPT VALUE
|
||
|
|
EN ; ENTRY
|
||
|
|
S $ZT="ZT" ; SET ERROR TRAP IN CASE OF BAD VALUE IN X
|
||
|
|
K ^XBXTSS,Y ; REMOVE POSSIBLE GARBAGE
|
||
|
|
S @("^XBXTSS"_X)="" ; SET DUMMY GLOBAL NODE
|
||
|
|
; USE NAKED REFERENCE TO HOP DOWN SUBSCRIPTS AND STACK THEM IN Y
|
||
|
|
S XBSS=$O(^XBXTSS("")) ; GET FIRST SUBSCRIPT - SET NAKED FOR NEXT LINE
|
||
|
|
F Y=1:1 S Y(Y)=XBSS,XBSS=$O(^(XBSS,"")) Q:XBSS="" ;STACK SUBSCRIPTS IN Y(Y)
|
||
|
|
K XBSS,^XBXTSS ; CLEANUP
|
||
|
|
Q ; RETURN TO CALLER
|
||
|
|
ZT ; TRAP ERRORS RETURN Y=0
|
||
|
|
S $ZE="",$ZT=""
|
||
|
|
K Y
|
||
|
|
S Y=0 ; RETURN ERROR TO CALLER
|
||
|
|
Q
|