Return to DICN.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DICN	;SFISC/GFT,XAK-ADD NEW ENTRY ;10/5/94  09:27
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: 	D:'$D(DO) DO^DIC1 S DO(1)=1
    5: 	G:$S($D(DLAYGO):DO(2)\1-(DLAYGO\1),1:1) B1
    6: USR	I $D(DD) S X=DD D N^DICN1 G I:$D(X),B
    7: 	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
    8: 	S X=DIX D VAL G I:$D(X)
    9: 	S X=DIX
   10: B	G BAD^DIC1
   11: 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
   12: 	;
   13: 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_")"
   14: Y	I $D(DDS) S A1="Q",DST=%_U_DST D H^DDSU Q
   15: 	W !,DST K DST
   16: YN	;
   17: 	N %1 S %1=$$EZBLD^DIALOG(7001) S:'$D(%) %=0 W "? " W:(%>0) $P(%1,U,%),"// "
   18: RX	R %Y:$S($D(DTIME):DTIME,1:300) E  S DTOUT=1,%Y=U W $C(7)
   19: 	I %Y]""!'% S %=+$$PRS^DIALOGU(7001,%Y) S:(%<0&($A(%Y)'=94)) %=0
   20: 	I '%,%Y'?."?" W $C(7),"??",!?4,$$EZBLD^DIALOG(8040),": " G RX
   21: 	W:$X>73 ! W:% $S(%>0:"  ("_$P(%1,U,%)_")",1:"") Q
   22: 	;
   23: DS	S DS=^DD(+DO(2),.01,0) Q
   24: 	;
   25: VAL	I X'?.ANP K X Q
   26: 	I X["""" K X Q
   27: 	I $P(DS,U,2)'["N",$A(X)=45 K X Q
   28: 	I $P(DS,U,2)["*" S:DS["DINUM" DINUM=X Q
   29: 	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
   30: 	;
   31: 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
   32: 	W:'$D(DDS) !,DST K A1 D:$D(DDS) H^DIC2 S DST="    "_$$EZBLD^DIALOG(8062,%) Q
   33: 	;
   34: 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
   35: 	G FILE:'$D(DD)
   36: 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
   37: 	I $D(DDS) S A1="Q",DST="3^"_DST D H^DDSU S X=% I $D(DTOUT) S X=U,Y=-1
   38: 	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
   39: FILE	D:'$D(DO) DO^DIC1 I DO="0^-1" G OUT
   40: 	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
   41: 	I $P($G(^DD($$FNO^DILIBF(+DO(2)),0,"DI")),U,2)["Y",'$D(DIOVRD),'$G(DIFROM) G OUT
   42: 	S DIX=X
   43: F1	S X=$P(DO,U,3) D INCR S X=X\DIY*DIY+DIY
   44: 	I $D(DINUM) S X=DINUM D INCR
   45: F2	I $D(@(DIC_"X)")) S X=X\DIY*DIY+DIY G B:$D(DINUM),F2
   46: 	S Y=$P(DO,"^",2) I $D(DD) S X=DD
   47: 	E  I 'Y,DUZ(0)'="@" G LOCK
   48: 	I DIC(0)["E",'$D(DINUM),$D(^DD(+Y,.001,0)) G NUM^DICN1
   49: LOCK	L @("+"_DIC_"X):1") I $D(@(DIC_"X)"))!'$T L @("-"_DIC_"X)") G F1
   50: 	S ^(X,0)=DIX,DD=0 L @("-"_DIC_"X)") K D S:$D(DA)#2 D=DA S DA=X,X=DIX
   51: 	I $D(@(DIC_"0)")) S ^(0)=$P(^(0),"^",1,2)_"^"_DA_"^"_($P(^(0),"^",4)+1)
   52: IX	S DS=X,DD=$O(^DD(+DO(2),.01,1,DD)) S:DD="" DD=-1
   53: 	I DD>0 G RIX^DICN1:^(DD,0)["TRIGGER"!(^(0)["BULL") X ^(1) S X=DS G IX
   54: 	I DIC(0)["E"&($O(^DD(+DO(2),0,"ID",0))>0)!$D(DIC("DR")) G ^DICN1
   55: D	D A
   56: 	S Y=DA_"^"_X_"^1" S:$D(D)#2 DA=D G R^DIC2
   57: 	;
   58: INCR	S DIY=1 I $P(DO,U,2)>1 F %=1:1:$L($P(X,".",2)) S DIY=DIY/10
   59: 	Q
   60: OUT	S Y=-1 G A^DIC:$D(DO(1))&'$D(DTOUT),Q^DIC2
   61: 	;
   62: A	I $P(^DD(+DO(2),.01,0),U,2)'["a",DO(2)'["a" Q
   63: 	I DO(2)'["a",^("AUDIT")["e" Q
   64: 	D AUD^DIET
   65: 	Q
   66: 	;#7001   Yes/No question
   67: 	;#8040   Answer with 'Yes' or 'No'
   68: 	;#8058   (the |entry number|
   69: 	;#8059   for this |filename|
   70: 	;#8060   Are you adding
   71: 	;#8061   '|.01 field value|' as
   72: 	;#8062   a new |filename|