XBDHDF1.m

XBDHDF1 ; IHS/ADC/GTH - CHECKS JUMP SYNTAX ; [ 02/07/97   3:02 PM ]

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

 ;

STRIP ;

 KILL XBDHTC

 I $E(Y,$L(Y))=":" S Y=$E(Y,1,$L(Y)-1),XBDHTC=""

 S X=$L(Y,":"),Z=$S(X>1:$P(Y,":",X),1:Y),A=""

 I $D(XBDHTC) D CKF I Y'=-1 G EXIT

 D CKPT

 I Y'=-1 G EXIT

 I $D(XBDHTC) W "  ??",*7,*7,*13,$J("",IOM),*13

EXIT ;

 KILL XBDHTC,Z

 Q

 ;

CKF ;

 S X=Z,DIC(0)="",DIC="^DD(XBDHDFN,"

 D ^DIC

 KILL DIC

 I Y=-1 Q

 S X=^DD(XBDHDFN,+Y,0),X=$P(X,U,2)

 I X'["P" S Y=-1 Q

 S X=+$P(X,"P",2),DIC="^DIC(",DIC(0)=""

 D ^DIC

 KILL DIC

 I Y=-1 Q

 D J1

 Q

 ;

CKPT ;

 S DIC="^DIC(",DIC(0)="",X=Z

 D ^DIC

 KILL DIC

 I Y=-1 Q

 F X=0:0 S A="",X=$O(^DD(XBDHDFN,0,"PT",+Y,X)) Q:X=""  D JUMPQ I "Y^"[A Q

 I X="" S Y=-1 Q

 I A="^" Q

 D J1

 Q

 ; 

J1 ;

 S XBDHDPTH=XBDHDPTH_XBDHXX_$S($D(XBDHTC):"",1:":")_";"

 S XBDHLIFO=XBDHLIFO+1,^TMP("XBDH",$J,"STACK",XBDHLIFO)=+Y_U_$P(Y,U,2)_U_U_XBDHDPTH

 Q

 ;

JUMPQ ;

 I '$D(^DD(+Y,"IX",X)) Q

 W !,"   By '",Z,"' do you mean the ",$P(Y,U,2)," File",!?7,"pointing via its '",$P(^DD(+Y,X,0),U),"' Field?  YES// "

 R A:DTIME

 S:'$T A="^"

 S A=$E(A)

 Q

 ;

XBDHDF1   ; IHS/ADC/GTH - CHECKS JUMP SYNTAX ; [ 02/07/97   3:02 PM ]

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

 +2       ;

STRIP     ;

 +1        KILL XBDHTC

 +2        IF $EXTRACT(Y,$LENGTH(Y))=":"

               SET Y=$EXTRACT(Y,1,$LENGTH(Y)-1)

               SET XBDHTC=""

 +3        SET X=$LENGTH(Y,":")

           SET Z=$SELECT(X>1:$PIECE(Y,":",X),1:Y)

           SET A=""

 +4        IF $DATA(XBDHTC)

               DO CKF

               IF Y'=-1

                   GOTO EXIT

 +5        DO CKPT

 +6        IF Y'=-1

               GOTO EXIT

 +7        IF $DATA(XBDHTC)

               WRITE "  ??",*7,*7,*13,$JUSTIFY("",IOM),*13

EXIT      ;

 +1        KILL XBDHTC,Z

 +2        QUIT 

 +3       ;

CKF       ;

 +1        SET X=Z

           SET DIC(0)=""

           SET DIC="^DD(XBDHDFN,"

 +2        DO ^DIC

 +3        KILL DIC

 +4        IF Y=-1

               QUIT 

 +5        SET X=^DD(XBDHDFN,+Y,0)

           SET X=$PIECE(X,U,2)

 +6        IF X'["P"

               SET Y=-1

               QUIT 

 +7        SET X=+$PIECE(X,"P",2)

           SET DIC="^DIC("

           SET DIC(0)=""

 +8        DO ^DIC

 +9        KILL DIC

 +10       IF Y=-1

               QUIT 

 +11       DO J1

 +12       QUIT 

 +13      ;

CKPT      ;

 +1        SET DIC="^DIC("

           SET DIC(0)=""

           SET X=Z

 +2        DO ^DIC

 +3        KILL DIC

 +4        IF Y=-1

               QUIT 

 +5        FOR X=0:0

               SET A=""

               SET X=$ORDER(^DD(XBDHDFN,0,"PT",+Y,X))

               IF X=""

                   QUIT 

               DO JUMPQ

               IF "Y^"[A

                   QUIT 

 +6        IF X=""

               SET Y=-1

               QUIT 

 +7        IF A="^"

               QUIT 

 +8        DO J1

 +9        QUIT 

 +10      ; 

J1        ;

 +1        SET XBDHDPTH=XBDHDPTH_XBDHXX_$SELECT($DATA(XBDHTC):"",1:":")_";"

 +2        SET XBDHLIFO=XBDHLIFO+1

           SET ^TMP("XBDH",$JOB,"STACK",XBDHLIFO)=+Y_U_$PIECE(Y,U,2)_U_U_XBDHDPTH

 +3        QUIT 

 +4       ;

JUMPQ     ;

 +1        IF '$DATA(^DD(+Y,"IX",X))

               QUIT 

 +2        WRITE !,"   By '",Z,"' do you mean the ",$PIECE(Y,U,2)," File",!?7,"pointing via its '",$PIECE(^DD(+Y,X,0),U),"' Field?  YES// "

 +3        READ A:DTIME

 +4        IF '$TEST

               SET A="^"

 +5        SET A=$EXTRACT(A)

 +6        QUIT 

 +7       ;