Return to DICN.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Initial commit

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|