source: IHS-VA_UTILITIES-XB/trunk/XBXTSS.m@ 674

Last change on this file since 674 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 949 bytes
Line 
1XBXTSS ;OHPRD-TUCSON/BRJ;EXTRACT AND TABLE SUBSCRIPTS
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ; X=SUBSCRIPT LIST ENCLOSED IN PARENTHESES PASSED BY CALLER
4 ; Y IS RETURNED AS:
5 ; Y=0 X VALUE NOT A PROPER SUBSCRIPT FORMAT
6 ; OR (SOME KIND OF ERROR ENCOUNTERED)
7 ; Y=n n=NUMBER OF SUBSCRIPTS IN X
8 ; Y(n)=value ARRAY OF SUBSCRIPTS
9 ; n=SUBSCRIPT POSITION
10 ; value=SUBSCRIPT VALUE
11EN ; ENTRY
12 S $ZT="ZT" ; SET ERROR TRAP IN CASE OF BAD VALUE IN X
13 K ^XBXTSS,Y ; REMOVE POSSIBLE GARBAGE
14 S @("^XBXTSS"_X)="" ; SET DUMMY GLOBAL NODE
15 ; USE NAKED REFERENCE TO HOP DOWN SUBSCRIPTS AND STACK THEM IN Y
16 S XBSS=$O(^XBXTSS("")) ; GET FIRST SUBSCRIPT - SET NAKED FOR NEXT LINE
17 F Y=1:1 S Y(Y)=XBSS,XBSS=$O(^(XBSS,"")) Q:XBSS="" ;STACK SUBSCRIPTS IN Y(Y)
18 K XBSS,^XBXTSS ; CLEANUP
19 Q ; RETURN TO CALLER
20ZT ; TRAP ERRORS RETURN Y=0
21 S $ZE="",$ZT=""
22 K Y
23 S Y=0 ; RETURN ERROR TO CALLER
24 Q
Note: See TracBrowser for help on using the repository browser.