Return to DICN.m CVS log

Up to [Coherent Logic Development] / freem_fileman

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