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