|
Last change
on this file since 641 was 641, checked in by Sam Habiel, 15 years ago |
|
Initial commit of XB, move away from sf.net.
Includes kids file and documentation.
|
|
File size:
949 bytes
|
| Line | |
|---|
| 1 | XBXTSS ;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
|
|---|
| 11 | EN ; 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
|
|---|
| 20 | ZT ; 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.
