- XBTM8 ; IHS/ADC/GTH - TECH MANUAL : EXTERNAL RELATIONS ; [ 02/07/97 3:02 PM ]
- ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- ;
- NEW A
- F A=1:1 S X=$P($T(PR+A),";;",2) Q:X="###" D PR(X) Q:$D(DUOUT)
- Q:$D(DUOUT)
- D ^DIWW
- KILL ^TMP("XBTM8",$J)
- NEW A,B
- S DIWF="WN"
- S %=$$RSEL^ZIBRSEL("XB*","^TMP(""XB"",$J,")
- S %=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XB"",$J,")
- ;
- S %=""
- F S %=$O(^TMP("XB",$J,%)) Q:%="" D
- .S B=$T(+1^@%)
- .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)
- .Q
- ;
- 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)
- D PR("|TOP|"),PR(" "),PR("Published entry points and supported routines:"),PR(" ")
- Q:$D(DUOUT)
- S (A,B)=""
- 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)
- ;
- KILL ^TMP("XBTM8",$J)
- Q:$D(DUOUT)
- S DIWF="W"
- Q
- ;
- PR(X) NEW %,A,B D PR^XBTM(X) Q
- ;;There are several published entry points that may be called
- ;;from other packages. Some XB/ZIB routines were programmed to be
- ;;available to call from the top of the routine, and are so noted in
- ;;the routine.
- ;;|SETTAB("C")||TAB|
- ;;|SETTAB("C")||TAB|
- ;;###
- XBTM8 ; IHS/ADC/GTH - TECH MANUAL : EXTERNAL RELATIONS ; [ 02/07/97 3:02 PM ]
- +1 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997
- +2 ;
- +3 NEW A
- +4 FOR A=1:1
- SET X=$PIECE($TEXT(PR+A),";;",2)
- IF X="###"
- QUIT
- DO PR(X)
- IF $DATA(DUOUT)
- QUIT
- +5 IF $DATA(DUOUT)
- QUIT
- +6 DO ^DIWW
- +7 KILL ^TMP("XBTM8",$JOB)
- +8 NEW A,B
- +9 SET DIWF="WN"
- +10 SET %=$$RSEL^ZIBRSEL("XB*","^TMP(""XB"",$J,")
- +11 SET %=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XB"",$J,")
- +12 ;
- +13 SET %=""
- +14 FOR
- SET %=$ORDER(^TMP("XB",$JOB,%))
- IF %=""
- QUIT
- Begin DoDot:1
- +15 SET B=$TEXT(+1^@%)
- +16 FOR A=3:1
- SET B=$TEXT(+A^@%)
- IF B=""
- QUIT
- IF '($EXTRACT(B)=" ")
- IF B[";PEP"
- SET ^TMP("XBTM8",$JOB,%,$PIECE(B," "))=$PIECE(B," ",2,999)
- +17 QUIT
- End DoDot:1
- +18 ;
- +19 FOR %=1:1
- SET B=$TEXT(L+%^XBLCALL)
- SET A=$PIECE(B,";",3)
- IF B=""
- QUIT
- IF $EXTRACT(A)=U
- SET A=$EXTRACT(A,2,99)
- SET ^TMP("XBTM8",$JOB,A,A)=$PIECE(B,";",4,999)
- +20 DO PR("|TOP|")
- DO PR(" ")
- DO PR("Published entry points and supported routines:")
- DO PR(" ")
- +21 IF $DATA(DUOUT)
- QUIT
- +22 SET (A,B)=""
- +23 FOR
- SET A=$ORDER(^TMP("XBTM8",$JOB,A))
- IF A=""
- QUIT
- IF $DATA(DUOUT)
- QUIT
- FOR
- SET B=$ORDER(^TMP("XBTM8",$JOB,A,B))
- IF B=""
- QUIT
- DO PR($EXTRACT($SELECT(A=B:"",1:$PIECE(B,"(",1))_U_A_$SELECT($LENGTH($PIECE(B,"(",2)):"(",1:"")_$PIECE(B,"(",2)_" : "_^(B),1,(DIWR-DIWL)))
- IF $DATA(DUOUT)
- QUIT
- +24 ;
- +25 KILL ^TMP("XBTM8",$JOB)
- +26 IF $DATA(DUOUT)
- QUIT
- +27 SET DIWF="W"
- +28 QUIT
- +29 ;
- PR(X) NEW %,A,B
- DO PR^XBTM(X)
- QUIT
- +1 ;;There are several published entry points that may be called
- +2 ;;from other packages. Some XB/ZIB routines were programmed to be
- +3 ;;available to call from the top of the routine, and are so noted in
- +4 ;;the routine.
- +5 ;;|SETTAB("C")||TAB|
- +6 ;;|SETTAB("C")||TAB|
- +7 ;;###
