Return to DICN.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICN.m, revision 1.1.1.1

1.1       snw         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|