source: IHS-VA_UTILITIES-XB/XBTMI.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.1 KB
Line 
1XBTMI ; IHS/ADC/GTH - TECH MANUAL : INDEXED WORDS; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 KILL ^TMP("XBTM-I",$J)
5 NEW A,I
6 D ALPHA
7 F %=19,19.1 S A="XAz" F S A=$O(^DIC(%,"B",A)) Q:'($E(A,1,2)="XB") S ^TMP("XBTM-I",$J,A)=""
8 F %=19,19.1 S A="ZIAz" F S A=$O(^DIC(%,"B",A)) Q:'($E(A,1,3)="ZIB") S ^TMP("XBTM-I",$J,A)=""
9 F %=1:1 S A=$P($T(1+%),";;",2) Q:A="" S ^TMP("XBTM-I",$J,A)=""
10 KILL ^TMP("XBTMI",$J)
11 S %=$$RSEL^ZIBRSEL("XB*","^TMP(""XBTMI"",$J,"),%=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XBTMI"",$J,")
12 S %=""
13 F S %=$O(^TMP("XBTMI",$J,%)) Q:%="" S ^TMP("XBTM-I",$J,%)="" F I=3:1 S A=$T(+I^@%) Q:A="" I $L($P(A," ")),A[";EP"!(A["ENTRY POINT")!(A[";PEP") S ^TMP("XBTM-I",$J,$P(A," ")_U_%)=""
14 KILL ^TMP("XBTMI",$J)
15 Q
16 ;
17ALPHA ;
18 NEW XBFLD,XBPIEN
19 S XBPIEN=$O(^DIC(9.4,"C","XB",0))
20 S %=0
21 F S %=$O(^DIC(9.4,XBPIEN,4,"B",%)) Q:'% D FLD
22 Q
23 ;
24FLD ;
25 S XBFLD=0
26 F S XBFLD=$O(^DD(%,XBFLD)) Q:'XBFLD D
27 .I +$P(^DD(%,XBFLD,0),U,2) S XB=+$P(^(0),U,2) D Q
28 ..NEW %,XBFLD S %=XB D FLD
29 ..Q
30 .S ^TMP("XBTM-I",$J,$P(^DD(%,XBFLD,0),U))=""
31 .Q
32 Q
33 ;
341 ;;
35 ;;CONTROL
36 ;;GUI
37 ;;LIST
38 ;;STANDARDS
39 ;;VIDEO
Note: See TracBrowser for help on using the repository browser.