Annotation of freem_fileman/USER/DIC2.m, revision 1.1

1.1     ! snw         1: DIC2   ;SF/XAK-LOOKUP (CONT) ;11/6/92  8:39 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4: WO     S DST=$G(DST)_"  " D WR I $D(DIC("W")),$D(@(DIC_"Y,0)")) D:$D(DDS)&'$D(DDH("ID")) ID^DICQ1 I '$D(DDS) W $G(DST),"  " X DIC("W") K DST
        !             5:        Q
        !             6: WR     D:'$D(DO) DO^DIC1 I DIC(0)["S",X'=" " Q:"  "[$G(DST)  G S
        !             7:        S DST=$G(DST)
        !             8:        I DO(2)["V" S %X=Y,DIYS=DIY D NAME^DICM2 S Y=%X,DIY=DIYS,DST=DST_DINAME K DINAME,%X G S
        !             9:        I DIY'?1.N.1".".N G W1
        !            10:        I DO(2)["D" S %=DIY D DT^DIC1 G S
        !            11:        I DO(2)["P",$D(@("^"_$P(^DD(+DO(2),.01,0),"^",3)_+DIY_",0)")) S %X=Y,Y=DIY,C=$P(^DD(+DO(2),.01,0),U,2) D Y^DIQ S DST=DST_Y,Y=%X G S
        !            12: W1     S:'$G(DIYX) DST=DST_DIY
        !            13: S      S A1=Y I '$D(DDS) W DST K DST,A1 Q
        !            14: H      S:'$D(A1) A1="T" S DDH=$G(DDH)+1,DDH(DDH,A1)=DST K DST,A1 Q
        !            15:        ;
        !            16: PGM    K DIPGM I DIC(0)'["I",'$D(DF),$D(@(DIC_"0)")),$D(^DD(+$P(^(0),U,2),0,"DIC"))#2,^("DIC")'?1"DI".E S DIPGM=U_^("DIC")
        !            17:        Q
        !            18:        ;
        !            19: GOT    I DIC(0)["E" D WO I $D(DDS),$D(DDH)>10 D LIST^DDSU K DDH("ID")
        !            20:        S Y=Y_"^"_$S(DIY="":X,$G(DIYX):X_DIY,1:DIY) I DIC(0)["E",DO(2)["O" G OK^DIC1
        !            21: R      D:'$D(DICR) ACT^DICM1 G A^DIC:Y<0
        !            22:        I DIC(0)["Z" K D S:$D(C)#2 D=C S Y(0)=@(DIC_"+Y,0)"),C=$P(^DD(+DO(2),.01,0),U,2),DS=Y,Y=$P(Y(0),U) D Y^DIQ S Y(0,0)=Y,Y=DS,Y(0)=@(DIC_"+Y,0)") S:$D(D) C=D
        !            23: ACT    I DIC(0)'["F",$D(DUZ)#2 S ^DISV(DUZ,$E(DIC,1,28))=$E(DIC,29,999)_+Y
        !            24:        I $D(@(DIC_"+Y,0)"))
        !            25: Q      K DIDA,DID,DISMN,DINUM,DS,DF,DD,DIX,DIY,DIYX,DZ,DO,D,DIAC,DIFILE
        !            26:        K:'$G(DICR) DIC("W")
        !            27:        Q

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