Return to DIC2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DIC2.m, revision 1.1.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