DICN ;SFISC/GFT,XAK-ADD NEW ENTRY ;10/5/94 09:27 ;;21.0;VA FileMan;;Dec 28, 1994 ;Per VHA Directive 10-93-142, this routine should not be modified. D:'$D(DO) DO^DIC1 S DO(1)=1 G:$S($D(DLAYGO):DO(2)\1-(DLAYGO\1),1:1) B1 USR I $D(DD) S X=DD D N^DICN1 G I:$D(X),B D DS S DIX=X I X'?16.N,X?.NP,X,DIC(0)["E",'$D(DICR),DS'["DINUM",$P(DS,U,2)'["N",DIC(0)["N"!$D(^DD(+DO(2),.001,0)) D N^DICN1 I $D(X) S DD=X G I S X=DIX D VAL G I:$D(X) S X=DIX B G BAD^DIC1 B1 G USR:'DO(2),USR:$D(^DD(+DO(2),0,"UP")),USR:DO(2)=".12P" S DIFILE=+DO(2),DIAC="LAYGO" D ^DIAC K DIAC,DIFILE G B:'%,USR ; 1 I '$D(DIC("S")) S DST=$G(DST)_$$EZBLD^DIALOG(8058,$$OUT^DIALOGU(Y,"ORD")) S:$D(^DD(+DO(2),0,"UP")) DST=DST_$$EZBLD^DIALOG(8059,$O(^DD(^("UP"),0,"NM",0))) S DST=DST_")" Y I $D(DDS) S A1="Q",DST=%_U_DST D H^DDSU Q W !,DST K DST YN ; N %1 S %1=$$EZBLD^DIALOG(7001) S:'$D(%) %=0 W "? " W:(%>0) $P(%1,U,%),"// " RX R %Y:$S($D(DTIME):DTIME,1:300) E S DTOUT=1,%Y=U W $C(7) I %Y]""!'% S %=+$$PRS^DIALOGU(7001,%Y) S:(%<0&($A(%Y)'=94)) %=0 I '%,%Y'?."?" W $C(7),"??",!?4,$$EZBLD^DIALOG(8040),": " G RX W:$X>73 ! W:% $S(%>0:" ("_$P(%1,U,%)_")",1:"") Q ; DS S DS=^DD(+DO(2),.01,0) Q ; VAL I X'?.ANP K X Q I X["""" K X Q I $P(DS,U,2)'["N",$A(X)=45 K X Q I $P(DS,U,2)["*" S:DS["DINUM" DINUM=X Q S %=$F(DS,"%DT=""E"),DS=$E(DS,1,%-2)_$E(DS,%,999) N DICTST S DICTST=DS["+X=X"&(X?16.N) K:DICTST X X:'DICTST $P(DS,U,5,99) Q ; I1 S DST=$C(7)_$$EZBLD^DIALOG(8060) S:'$D(DD) DST=DST_$$EZBLD^DIALOG(8061,Y) S %=$P(DO,U,1) I $L(DST)+$L(%)'>55 S DST=DST_$$EZBLD^DIALOG(8062,%) Q W:'$D(DDS) !,DST K A1 D:$D(DDS) H^DIC2 S DST=" "_$$EZBLD^DIALOG(8062,%) Q ; I I DIC(0)["E",DO(2)'["A",DIC(0)'["W" S C=$P(^DD(+DO(2),.01,0),U,2),(DIX,Y)=X D Y^DIQ,I1 S %=0,Y=$P(DO,U,4)+1,X=DIX D 1 G OUT:$D(DTOUT),B:%-1 G FILE:'$D(DD) R D DS S DST=" "_$P(DS,U,1)_": " I '$D(DDS) W !,DST K DST R X:DTIME S:'$T X=U,DTOUT=1,Y=-1 I $D(DDS) S A1="Q",DST="3^"_DST D H^DDSU S X=% I $D(DTOUT) S X=U,Y=-1 G B:X[U,R:X="" D VAL I '$D(X) W $C(7) W:'$D(DDS) "??" G:'$D(^DD(+DO(2),.01,3)) R S DST=" "_^(3) W:'$D(DDS) !,DST D:$D(DDS) H^DDSU G R FILE D:'$D(DO) DO^DIC1 I DO="0^-1" G OUT F DIX=0:0 S DIX=$O(^DD(+DO(2),.01,"LAYGO",DIX)) Q:DIX'>0 I $D(^(DIX,0)) X ^(0) I '$T G OUT I $P($G(^DD($$FNO^DILIBF(+DO(2)),0,"DI")),U,2)["Y",'$D(DIOVRD),'$G(DIFROM) G OUT S DIX=X F1 S X=$P(DO,U,3) D INCR S X=X\DIY*DIY+DIY I $D(DINUM) S X=DINUM D INCR F2 I $D(@(DIC_"X)")) S X=X\DIY*DIY+DIY G B:$D(DINUM),F2 S Y=$P(DO,"^",2) I $D(DD) S X=DD E I 'Y,DUZ(0)'="@" G LOCK I DIC(0)["E",'$D(DINUM),$D(^DD(+Y,.001,0)) G NUM^DICN1 LOCK L @("+"_DIC_"X):1") I $D(@(DIC_"X)"))!'$T L @("-"_DIC_"X)") G F1 S ^(X,0)=DIX,DD=0 L @("-"_DIC_"X)") K D S:$D(DA)#2 D=DA S DA=X,X=DIX I $D(@(DIC_"0)")) S ^(0)=$P(^(0),"^",1,2)_"^"_DA_"^"_($P(^(0),"^",4)+1) IX S DS=X,DD=$O(^DD(+DO(2),.01,1,DD)) S:DD="" DD=-1 I DD>0 G RIX^DICN1:^(DD,0)["TRIGGER"!(^(0)["BULL") X ^(1) S X=DS G IX I DIC(0)["E"&($O(^DD(+DO(2),0,"ID",0))>0)!$D(DIC("DR")) G ^DICN1 D D A S Y=DA_"^"_X_"^1" S:$D(D)#2 DA=D G R^DIC2 ; INCR S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10 Q OUT S Y=-1 G A^DIC:$D(DO(1))&'$D(DTOUT),Q^DIC2 ; A I $P(^DD(+DO(2),.01,0),U,2)'["a",DO(2)'["a" Q I DO(2)'["a",^("AUDIT")["e" Q D AUD^DIET Q ;#7001 Yes/No question ;#8040 Answer with 'Yes' or 'No' ;#8058 (the |entry number| ;#8059 for this |filename| ;#8060 Are you adding ;#8061 '|.01 field value|' as ;#8062 a new |filename|