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