File:  [Coherent Logic Development] / freem_fileman / USER / DIDH.m
Revision 1.1: download - view: text, annotated - select for diffs
Mon Apr 28 14:13:20 2025 UTC (3 months ago) by snw
Branches: MAIN
CVS tags: HEAD
Restructure repository

    1: DIDH	;SFISC/XAK-HDR FOR DD LISTS ;2/18/93  16:21 ;
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	D ^DIDH1
    5: Q	K DDV,%F,M1 Q
    6: 	;
    7: XR	S X=2,J=0,DG=F(Z) W:$Y !
    8: XL	S J=$O(^DD(DA,0,"IX",J)) I J="" S F(Z)=DG Q
    9: 	F K=0:0 S K=$O(^DD(DA,0,"IX",J,K)) G XL:K'>0 F N=0:0 S N=$O(^DD(DA,0,"IX",J,K,N)) Q:N'>0  I 1 S F(Z)=K,DJ(Z)=N X:$D(DIGR) DIGR D:$T XL1
   10: XL1	F %=0:0 S %=$O(^DD(K,N,1,%)) Q:'%!(M=U)  I $D(^(%,0)),+^(0)=DA,$P(^(0),U,2)=J W:X=2 !,"CROSS",! W $P(", ^REFERENCED BY: ",U,X) S X=$P(^DD(K,N,0),U)_"("_J_")" W:($L(X)+$X+4)'<IOM !?15 W X S X=1 Q:$Y+4'>IOSL  I '$D(DIU) D H S X=2
   11: 	Q
   12: POINT	; CALLED BY ^DD(1,.01,"DEL",.5,0)
   13: 	S W1="W:$Y ! W !,""POINTED TO BY: "",?15" I $O(^DD(DA,0,"PT",""))'="" S DDPT=1
   14: 	S X="" F  S X=$O(^DD(DA,0,"PT",X)) Q:X=""  S DG=0 F  S DG=$O(^DD(DA,0,"PT",X,DG)) Q:DG=""  D PD W:$D(^DD(DA,0,"PT",X,DG)) !?15 I '$D(DIU) D H G Q:M=U
   15: 	S (DG,X)=-1 K W1,DDPT Q
   16: PD	I $S('$D(^DD(X,DG,0)):1,$P(^(0),U,2)["V":0,1:$P($P(^(0),U,2),"P",2)-DA) K ^DD(DA,0,"PT",X,DG) Q
   17: 	S %=X,%F=DG
   18: WR	I '$D(IOM) S IOP="HOME" N %X D ^%ZIS Q:POP
   19: 	I $D(DDPT) X W1 K DDPT
   20: 	S X1=$P(^DD(%,%F,0),U)_" field (#"_%F_")"
   21: UP	I $L(X1)+$L(%)+$L($O(^DD(%,0,"NM",0)))>225 S X1=X1_" etc... ^" G L1
   22: 	S X1=X1_" of the "_$O(^(0))
   23: 	I $D(^DD(%,0,"UP")) S X1=X1_" sub-field (#"_%_")",%=^("UP") G UP
   24: 	S X1=X1_" File (#"_%_") ^"
   25: L1	F DDC=1:1 S DDV=$P(X1," ",DDC)_" " Q:DDV["^"  W:$L(DDV)+$X>IOM !,?19 W DDV
   26: 	K DDC,DDV,X1 Q
   27: 	;
   28: TRIG	;CALLED BY ^DD(1,.01,"DEL","TRB",0)
   29: 	S W1="W:$Y ! W !,""A FIELD IS"",!,""TRIGGERED BY :"",?15",DDPT=1
   30: 	K X S X="" F  S X=$O(^DD(DA,"TRB",X)) Q:X=""  I X-DA,'$D(^DD(DA,"SB",X)) S %=0 F  S %=$O(^DD(DA,"TRB",X,%)) Q:%=""  S %X=0 F  S %X=$O(^DD(DA,"TRB",X,%,%X)) Q:%X=""  S %Y=0 F  S %Y=$O(^DD(DA,"TRB",X,%,%X,%Y)) Q:%Y'>0  D TT
   31: 	S %Y=-1 I $D(X)>9 S %X=0 F  S %X=$O(X(%X)) Q:%X=""  S X=0 F  S X=$O(X(%X,X)) Q:X=""  S %F=X,%=%X D WR:$D(^DD(%,X,0)) W !?15 D:'$D(DIU) H I 1
   32: 	K X,%X,%Y,W1,DDPT Q
   33: 	;
   34: TT	S X(X,%)=0 I $D(^DD(X,%,0)) Q:$P(^(0),U,2)  I $D(^(1,%X,0)),^(0)["TRIGGER" Q
   35: 	K X(X,%),^DD(DA,"TRB",X,%,%X,%Y)
   36: 	Q
   37: H	I $D(IOSL),$Y+4>IOSL S DC=DC+1 D ^DIDH1 G Q:M=U
   38: 	Q
   39: W	F K=0:1 W:$D(DDF) !?25 S %Y=$E(W,IOM-$X,999) W $E(W,1,IOM-$X-1) Q:%Y=""  S W=%Y,DDF=1
   40: 	K DDF Q

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>