XBTMI.m

XBTMI ; IHS/ADC/GTH - TECH MANUAL : INDEXED WORDS; [ 02/07/97   3:02 PM ]

 ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 ;

 KILL ^TMP("XBTM-I",$J)

 NEW A,I

 D ALPHA

 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)=""

 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)=""

 F %=1:1 S A=$P($T(1+%),";;",2) Q:A=""  S ^TMP("XBTM-I",$J,A)=""

 KILL ^TMP("XBTMI",$J)

 S %=$$RSEL^ZIBRSEL("XB*","^TMP(""XBTMI"",$J,"),%=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XBTMI"",$J,")

 S %=""

 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_%)=""

 KILL ^TMP("XBTMI",$J)

 Q

 ;

ALPHA ;

 NEW XBFLD,XBPIEN

 S XBPIEN=$O(^DIC(9.4,"C","XB",0))

 S %=0

 F  S %=$O(^DIC(9.4,XBPIEN,4,"B",%)) Q:'%  D FLD

 Q

 ;

FLD ;

 S XBFLD=0

 F  S XBFLD=$O(^DD(%,XBFLD)) Q:'XBFLD  D

 .I +$P(^DD(%,XBFLD,0),U,2) S XB=+$P(^(0),U,2) D  Q

 ..NEW %,XBFLD S %=XB D FLD

 ..Q

 .S ^TMP("XBTM-I",$J,$P(^DD(%,XBFLD,0),U))=""

 .Q

 Q

 ;

1 ;; 

 ;;CONTROL

 ;;GUI

 ;;LIST

 ;;STANDARDS

 ;;VIDEO

XBTMI     ; IHS/ADC/GTH - TECH MANUAL : INDEXED WORDS; [ 02/07/97   3:02 PM ]

 +1       ;;3.0;IHS/VA UTILITIES;;FEB 07, 1997

 +2       ;

 +3        KILL ^TMP("XBTM-I",$JOB)

 +4        NEW A,I

 +5        DO ALPHA

 +6        FOR %=19,19.1

               SET A="XAz"

               FOR 

                   SET A=$ORDER(^DIC(%,"B",A))

                   IF '($EXTRACT(A,1,2)="XB")

                       QUIT 

                   SET ^TMP("XBTM-I",$JOB,A)=""

 +7        FOR %=19,19.1

               SET A="ZIAz"

               FOR 

                   SET A=$ORDER(^DIC(%,"B",A))

                   IF '($EXTRACT(A,1,3)="ZIB")

                       QUIT 

                   SET ^TMP("XBTM-I",$JOB,A)=""

 +8        FOR %=1:1

               SET A=$PIECE($TEXT(1+%),";;",2)

               IF A=""

                   QUIT 

               SET ^TMP("XBTM-I",$JOB,A)=""

 +9        KILL ^TMP("XBTMI",$JOB)

 +10       SET %=$$RSEL^ZIBRSEL("XB*","^TMP(""XBTMI"",$J,")

           SET %=$$RSEL^ZIBRSEL("ZIB*","^TMP(""XBTMI"",$J,")

 +11       SET %=""

 +12       FOR 

               SET %=$ORDER(^TMP("XBTMI",$JOB,%))

               IF %=""

                   QUIT 

               SET ^TMP("XBTM-I",$JOB,%)=""

               FOR I=3:1

                   SET A=$TEXT(+I^@%)

                   IF A=""

                       QUIT 

                   IF $LENGTH($PIECE(A," "))

                       IF A[";EP"!(A["ENTRY POINT")!(A[";PEP")

                           SET ^TMP("XBTM-I",$JOB,$PIECE(A," ")_U_%)=""

 +13       KILL ^TMP("XBTMI",$JOB)

 +14       QUIT 

 +15      ;

ALPHA     ;

 +1        NEW XBFLD,XBPIEN

 +2        SET XBPIEN=$ORDER(^DIC(9.4,"C","XB",0))

 +3        SET %=0

 +4        FOR 

               SET %=$ORDER(^DIC(9.4,XBPIEN,4,"B",%))

               IF '%

                   QUIT 

               DO FLD

 +5        QUIT 

 +6       ;

FLD       ;

 +1        SET XBFLD=0

 +2        FOR 

               SET XBFLD=$ORDER(^DD(%,XBFLD))

               IF 'XBFLD

                   QUIT 

               Begin DoDot:1

 +3                IF +$PIECE(^DD(%,XBFLD,0),U,2)

                       SET XB=+$PIECE(^(0),U,2)

                       Begin DoDot:2

 +4                        NEW %,XBFLD

                           SET %=XB

                           DO FLD

 +5                        QUIT 

                       End DoDot:2

                       QUIT 

 +6                SET ^TMP("XBTM-I",$JOB,$PIECE(^DD(%,XBFLD,0),U))=""

 +7                QUIT 

               End DoDot:1

 +8        QUIT 

 +9       ;

1         ;; 

 +1       ;;CONTROL

 +2       ;;GUI

 +3       ;;LIST

 +4       ;;STANDARDS

 +5       ;;VIDEO