Annotation of freem_fileman/DIE3.m, revision 1.1

1.1     ! snw         1: DIE3   ;SFISC/XAK-PROCESS SINGLE-VALUED VARIABLE PNTR ;9/27/94  11:08
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: V      ;
        !             5:        S DIEX=X ;I $D(DNM) S DIDS=D
        !             6:        G ALL:X'["." S DIVP=$P(X,"."),X=$P(X,".",2,999),Y=-1,A9=1 I X="" G Q
        !             7:        I DIVP]"",$D(^DD(DP,DIFLD,"V","P",DIVP)) D FND G Q
        !             8:        I DIVP="" G ALL
        !             9:        S X="" F %=0:0 S X=$O(^DD(DP,DIFLD,"V","M",X)) Q:X=""  I $P(X,DIVP)="" S DIVP=X,X=$P(DIEX,".",2,999) D FND G Q:Y>0 S X=$P(DIEX,".")
        !            10:        F DIVP=0:0 S DIVP=$O(^DD(DP,DIFLD,"V",DIVP)) Q:+DIVP'>0  I $D(^(DIVP,0)) S DIVPDIC=^(0) I $D(^DIC(+DIVPDIC,0)) S %=$P(^(0),U) I $P(%,$P(DIEX,"."))="" S X=$P(DIEX,".",2,999) D DIC G Q:Y>0 S X=$P(DIEX,".")
        !            11:        I A9 S X=DIEX,A9=0 G ALL
        !            12:        G Q
        !            13:        ;
        !            14: ALL    F DIVP1=0:0 S DIVP1=$O(^DD(DP,DIFLD,"V","O",DIVP1)) Q:+DIVP1'>0  S DIVP=DIVP1 D FND Q:Y>0  S X=DIEX
        !            15:        G Q
        !            16:        ;
        !            17: FND    S DIVP=+$O(^(DIVP,0)) I $D(^DD(DP,DIFLD,"V",DIVP,0)) S DIVPDIC=^(0) D DIC
        !            18:        I Y>0 S A9=0
        !            19:        Q
        !            20:        ;
        !            21: DIC    I '$D(^DIC(+DIVPDIC,0,"GL")) S Y=-1 Q
        !            22:        I $D(DIC("V")) S Y=DIVP,Y(0)=DIVPDIC X DIC("V") I '$T K Y S Y=-1 Q
        !            23:        I $D(DIVP1),'$D(DB(DQ)),'$G(DIQUIET) D H1
        !            24:        S DIC=^DIC(+DIVPDIC,0,"GL"),DIC(0)="MD"_$E("E",'$D(DB(DQ))&'$D(DIR("V")))_$E("L",$P(DIVPDIC,U,6)="y")_$E("Z",$D(DDS)) I $P(DIVPDIC,U,5)="y",$D(^DD(DP,DIFLD,"V",DIVP,1)),^(1)]"" X ^(1)
        !            25:        I $D(DIR)=10,'$D(DDS) S DIC(0)=$P(DIC(0),"L")_$P(DIC(0),"L",2)
        !            26:        D ^DIC S X=+Y_";"_$E(DIC,2,99) K:Y<0 X S %=1
        !            27:        I Y>0,$D(DIVP1),'$D(DB(DQ)),'$P(Y,U,3),$P(^DIC(+DIVPDIC,0),U,2)'["O",'$G(DIQUIET) D S1
        !            28:        D  Q 
        !            29:        .N DICV
        !            30:        .I $D(DIC("V")) S DICV=DIC("V")
        !            31:        .K DIC S DIC=DIE S:$D(DICV) DIC("V")=DICV
        !            32:        .Q
        !            33:        ;
        !            34: S1     S A1="Q",DST=%_U_"        ...OK" D S S:%=2!(%<0) Y=-1 Q
        !            35:        ;
        !            36: H      S DDH=$S($D(DDH):DDH+1,1:1),DDH(DDH,A1)=DST K DST Q
        !            37:        ;
        !            38: H1     ;also called by DICM3
        !            39:        W:'$D(DDS) !
        !            40:        S A1="T",DST=$$EZBLD^DIALOG(8070,$P(DIVPDIC,U,2))
        !            41: S      I $D(DDS) D H S DDD=1 D ^DDSU K DDD G QS
        !            42:        I A1["T" W !,DST G QS
        !            43:        I A1["Q" S %=+$P(DST,U,1) W !,$P(DST,U,2) D YN^DICN G QS
        !            44:        I A1["X" X DST
        !            45: QS     K A1,DST Q
        !            46:        ;
        !            47: Q      K A1,DIVP1,DIVP,DIVPDIC,A9
        !            48:        I $D(DNM) G:Y>0 @("V^"_DNM) S X=DIEX K DIEX G X^DIE17:'$D(DB(DQ)),B^DIE17
        !            49:        K DIEX Q:$D(DIR)  G V^DIED:Y>0,X^DIED:'$D(DB(DQ)),B^DIE1
        !            50:        ;
        !            51:        ;#8070  Searching for a |filename|

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