XBTM8.m

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       ;;###