Return to DICM0.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DICM0.m, revision 1.1

1.1     ! snw         1: DICM0  ;SF/XAK - LOOKUP WHEN INPUT MUST BE TRANSFORMED ;2/17/93 12:21 ;
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: P      ;Pointers, called by ^DICM1
        !             6:        S DICR(DICR,1)=DIC,DIC=U_$P(DS,U,3),Y=DIC(0),(D,DIC(0))=$P(Y,"L",1)_$P(Y,"L",2),DICR(DICR,2)=$S(%="B":Y,1:D),DICR(DICR,2.1)=$S($P(DS,U,2)["'":D,1:Y)
        !             7:        S DIC(0)=$P(D,"N",1)_$P(D,"N",2)
        !             8:        F Y="S","P","W" I $D(DIC(Y)) S DICR(DICR,Y)=DIC(Y) K DIC(Y)
        !             9: AST    G P1:$P(DS,U,2)'["*"
        !            10:        F D=" D ^DIC"," D IX^DIC"," D MIX^DIC1" S Y=$F(DS,D) I Y X $P($E(DS,1,Y-$L(D)-1),U,5,99) S:DS["DIC(0)=" DICR(DICR,2.1)=DIC(0) I $D(DIC("S")) S DICR(DICR,31)=DIC("S")
        !            11: P1     S Y="("_DICR(DICR,1) G L1:'$D(DO) K DO I @("$O"_Y_"0))'>0") G L1
        !            12:        S I="DIC"_DICR,D="X ""I 0"" F "_I_"=0:0 S "_I_"=$O"_Y,%=""""_%_"""" I @("$O"_Y_%_",0))>0") S D=D_%_",Y,"_I_")) Q:"_I_"'>0  I $D"_Y_I_",0))"
        !            13:        E  I DS["DINUM=X" S D="I $D"_Y_"Y,0)) S "_I_"=Y"
        !            14:        E  S D=D_I_")) Q:"_I_"'>0  I $P(^("_I_",0),U)=Y"
        !            15:        I $D(DICR(DICR,31)) S D="X DICR("_DICR_",31) "_D
        !            16:        I $D(DICR(DICR,"S")) S D=D_" S %Y"_DICR_"=Y,Y="_I_" X DICR("_DICR_",""S"") S Y=%Y"_DICR_" I "
        !            17:        S DIC("S")=D_" Q",D="B",Y=0 D X^DIC
        !            18: L1     K DIC("S"),@("DIC"_DICR) I Y'>0,'$D(DICR(DICR,8)) S:$D(DICR(DICR,31)) DIC("S")=DICR(DICR,31) G RETRY
        !            19:        I DICR(DICR,2)["L",DICR(DICR,2)["E",@("$P("_DIC_"0),U,2)'[""O"""),$P(@(DICR(DICR,1)_"0)"),U,2)'["O" S DST="         ...OK",%=1 D Y^DICN W:'$D(DDS) ! G:%-1 L2
        !            20: R      K DICS,DICW,DO,DIC("W"),DIC("S")
        !            21:        S DIC=DICR(DICR,1),%=DICR(DICR,2),DIC(0)=$P(%,"M")_$P(%,"M",2)
        !            22:        F X="S","P","W" S:$D(DICR(DICR,X)) DIC(X)=DICR(DICR,X)
        !            23:        I $D(DIC("P")),+DIC("P")=.12 S DIC(0)=DIC(0)_"X"
        !            24:        D DO^DIC1 S X=+Y K:X'>0 X Q
        !            25:        ;
        !            26: L2     G NO:%-2 S DIC("S")="I Y-"_+Y_$S($D(DICR(DICR,31)):" "_DICR(DICR,31),1:""),X=DICR(DICR) W:'$D(DDS) "     "_X I $D(DDS),$G(DDH) D LIST^DDSU
        !            27:        K DST ;
        !            28: RETRY  D DO^DIC1 K DICR(U,+DO(2)) S D="B",DIC(0)=DICR(DICR,2.1) D X^DIC K DICR(DICR,6)
        !            29:        G R
        !            30:        ;
        !            31: NO     S Y=-1 G R
        !            32:        ;