source: IHS-VA_UTILITIES-XB/XBDHDF1.m@ 641

Last change on this file since 641 was 641, checked in by Sam Habiel, 14 years ago

Initial commit of XB, move away from sf.net.
Includes kids file and documentation.

File size: 1.1 KB
Line 
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.