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>