XBXTSS.m

XBXTSS ;OHPRD-TUCSON/BRJ;EXTRACT AND TABLE SUBSCRIPTS 

 ;;2.6;IHS UTILITIES;;JUN 28, 1993

 ; 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

XBXTSS    ;OHPRD-TUCSON/BRJ;EXTRACT AND TABLE SUBSCRIPTS 

 +1       ;;2.6;IHS UTILITIES;;JUN 28, 1993

 +2       ; X=SUBSCRIPT LIST ENCLOSED IN PARENTHESES PASSED BY CALLER

 +3       ; Y IS RETURNED AS:

 +4       ;   Y=0           X VALUE NOT A PROPER SUBSCRIPT FORMAT

 +5       ;                  OR (SOME KIND OF ERROR ENCOUNTERED)

 +6       ;   Y=n           n=NUMBER OF SUBSCRIPTS IN X

 +7       ;   Y(n)=value    ARRAY OF SUBSCRIPTS

 +8       ;                 n=SUBSCRIPT POSITION

 +9       ;                 value=SUBSCRIPT VALUE

EN        ; ENTRY

 +1       ; SET ERROR TRAP IN CASE OF BAD VALUE IN X

           SET $ZT="ZT"

 +2       ; REMOVE POSSIBLE GARBAGE

           KILL ^XBXTSS,Y

 +3       ; SET DUMMY GLOBAL NODE

           SET @("^XBXTSS"_X)=""

 +4       ; USE NAKED REFERENCE TO HOP DOWN SUBSCRIPTS AND STACK THEM IN Y

 +5       ; GET FIRST SUBSCRIPT - SET NAKED FOR NEXT LINE

           SET XBSS=$ORDER(^XBXTSS(""))

 +6       ;STACK SUBSCRIPTS IN Y(Y)

           FOR Y=1:1

               SET Y(Y)=XBSS

               SET XBSS=$ORDER(^(XBSS,""))

               IF XBSS=""

                   QUIT 

 +7       ; CLEANUP

           KILL XBSS,^XBXTSS

 +8       ; RETURN TO CALLER

           QUIT 

ZT        ; TRAP ERRORS RETURN Y=0

 +1        SET $ZE=""

           SET $ZT=""

 +2        KILL Y

 +3       ; RETURN ERROR TO CALLER

           SET Y=0

 +4        QUIT