source: IHS-VA_UTILITIES-XB/trunk/XBTMI.m@ 1680

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

Modified directory structure; moved routines.

File size: 1.1 KB
RevLine 
[641]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.