source: IHS-VA_UTILITIES-XB/XBTM8.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.3 KB
Line 
1XBTM8 ; IHS/ADC/GTH - TECH MANUAL : EXTERNAL RELATIONS ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4 NEW A
5 F A=1:1 S X=$P($T(PR+A),";;",2) Q:X="###" D PR(X) Q:$D(DUOUT)
6 Q:$D(DUOUT)
7 D ^DIWW
8 KILL ^TMP("XBTM8",$J)
9 NEW A,B
10 S DIWF="WN"
11 S %=$$RSEL^ZIBRSEL("XB*","^TMP(""XB"",$J,")
12 S %=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XB"",$J,")
13 ;
14 S %=""
15 F S %=$O(^TMP("XB",$J,%)) Q:%="" D
16 .S B=$T(+1^@%)
17 .F A=3:1 S B=$T(+A^@%) Q:B="" I '($E(B)=" ") I B[";PEP" S ^TMP("XBTM8",$J,%,$P(B," "))=$P(B," ",2,999)
18 .Q
19 ;
20 F %=1:1 S B=$T(L+%^XBLCALL),A=$P(B,";",3) Q:B="" I $E(A)=U S A=$E(A,2,99),^TMP("XBTM8",$J,A,A)=$P(B,";",4,999)
21 D PR("|TOP|"),PR(" "),PR("Published entry points and supported routines:"),PR(" ")
22 Q:$D(DUOUT)
23 S (A,B)=""
24 F S A=$O(^TMP("XBTM8",$J,A)) Q:A="" Q:$D(DUOUT) F S B=$O(^TMP("XBTM8",$J,A,B)) Q:B="" D PR($E($S(A=B:"",1:$P(B,"(",1))_U_A_$S($L($P(B,"(",2)):"(",1:"")_$P(B,"(",2)_" : "_^(B),1,(DIWR-DIWL))) Q:$D(DUOUT)
25 ;
26 KILL ^TMP("XBTM8",$J)
27 Q:$D(DUOUT)
28 S DIWF="W"
29 Q
30 ;
31PR(X) NEW %,A,B D PR^XBTM(X) Q
32 ;;There are several published entry points that may be called
33 ;;from other packages. Some XB/ZIB routines were programmed to be
34 ;;available to call from the top of the routine, and are so noted in
35 ;;the routine.
36 ;;|SETTAB("C")||TAB|
37 ;;|SETTAB("C")||TAB|
38 ;;###
Note: See TracBrowser for help on using the repository browser.