source: IHS-VA_UTILITIES-XB/trunk/XBTM8.m@ 1119

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

Modified directory structure; moved routines.

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