source: IHS-VA_UTILITIES-XB/trunk/XBDHDF1.m@ 801

Last change on this file since 801 was 642, checked in by Sam Habiel, 15 years ago

Modified directory structure; moved routines.

File size: 1.1 KB
RevLine 
[641]1XBDHDF1 ; IHS/ADC/GTH - CHECKS JUMP SYNTAX ; [ 02/07/97 3:02 PM ]
2 ;;4.0;XB;;Jul 20, 2009;Build 2
3 ;
4STRIP ;
5 KILL XBDHTC
6 I $E(Y,$L(Y))=":" S Y=$E(Y,1,$L(Y)-1),XBDHTC=""
7 S X=$L(Y,":"),Z=$S(X>1:$P(Y,":",X),1:Y),A=""
8 I $D(XBDHTC) D CKF I Y'=-1 G EXIT
9 D CKPT
10 I Y'=-1 G EXIT
11 I $D(XBDHTC) W " ??",*7,*7,*13,$J("",IOM),*13
12EXIT ;
13 KILL XBDHTC,Z
14 Q
15 ;
16CKF ;
17 S X=Z,DIC(0)="",DIC="^DD(XBDHDFN,"
18 D ^DIC
19 KILL DIC
20 I Y=-1 Q
21 S X=^DD(XBDHDFN,+Y,0),X=$P(X,U,2)
22 I X'["P" S Y=-1 Q
23 S X=+$P(X,"P",2),DIC="^DIC(",DIC(0)=""
24 D ^DIC
25 KILL DIC
26 I Y=-1 Q
27 D J1
28 Q
29 ;
30CKPT ;
31 S DIC="^DIC(",DIC(0)="",X=Z
32 D ^DIC
33 KILL DIC
34 I Y=-1 Q
35 F X=0:0 S A="",X=$O(^DD(XBDHDFN,0,"PT",+Y,X)) Q:X="" D JUMPQ I "Y^"[A Q
36 I X="" S Y=-1 Q
37 I A="^" Q
38 D J1
39 Q
40 ;
41J1 ;
42 S XBDHDPTH=XBDHDPTH_XBDHXX_$S($D(XBDHTC):"",1:":")_";"
43 S XBDHLIFO=XBDHLIFO+1,^TMP("XBDH",$J,"STACK",XBDHLIFO)=+Y_U_$P(Y,U,2)_U_U_XBDHDPTH
44 Q
45 ;
46JUMPQ ;
47 I '$D(^DD(+Y,"IX",X)) Q
48 W !," By '",Z,"' do you mean the ",$P(Y,U,2)," File",!?7,"pointing via its '",$P(^DD(+Y,X,0),U),"' Field? YES// "
49 R A:DTIME
50 S:'$T A="^"
51 S A=$E(A)
52 Q
53 ;
Note: See TracBrowser for help on using the repository browser.