Return to DITC.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DITC.m, revision 1.1

1.1     ! snw         1: DITC   ;SFISC/XAK-MERGE OR COMPARE ENTRIES ;9/17/91  10:36 AM
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5: START  ;
        !             6:        K DFF,DIT,DIMERGE,DDSP,DDIF,DDEF,DITC,DMSG
        !             7:        D K2,K1,T^DICRW G:Y<0 END S (DSUB,DIT,L)=0,DSUB(L)=DIC,DITC=1
        !             8: SUB    S %=$P(Y,U,2),Y=+Y D SUB^DICRW K DIA
        !             9: ENTR   G:X["^"!($D(DTOUT)) END K DIC S DIC(0)="AEQMZ",DIC=DSUB(0),DFL=1,DIT=DIT+1,DIT(DIT)="" W:DIT=1 !
        !            10: E1     S DIC("A")=$E("        ",1,DFL-1*3)_$S(DIT=2:" WITH ",1:"COMPARE ")_DFL(DFL)_": " I (DIT=2),(DFL=L),($P(DIT(1),",",1,L-1)=$P(DIT(2),",",1,L-1)) S DIC("S")="I Y-"_$P(DIT(1),",",L)
        !            11:        D ^DIC K DIC("S"),DIC("A") I Y>0,$D(DSUB(DFL)),$D(DFL(DFL+1)) S DIC=DIC_+Y_","_DSUB(DFL),DIT(DIT)=DIT(DIT)_+Y_",",DFL=DFL+1 S %=$O(@(DIC_"-1)")) G:'% E1 S:%>0 ^(0)=U_DFF_U I %<0 W !,"NO "_DFL(DFL) S Y=-1
        !            12:        G:X=U END G:Y=-1 START S DTO(DIT)=DIC_+Y_",",DTO(DIT,"X")=Y(0,0),DIT(DIT)=DIT(DIT)_+Y G:DIT=1 ENTR S DDSP=1
        !            13: Q1     S %=2 W !!,"WILL YOU WANT TO MERGE THESE ENTRIES AFTER COMPARING THEM" D YN^DICN I '% W ! S DMSG=1 D HELP^DITC0 G Q1
        !            14:        S:%=1 DIMERGE=1 G:%<0 END G:'$D(DIMERGE) Q2 W ! F I=1,2 W !?5,I,?10,DTO(I,"X")
        !            15: Q15    R !!,"WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES (1 OR 2)? ",X:DTIME S:X[U DUOUT=1 S:'$T X=U,DTOUT=1 G:X["^" END I X="?" S DMSG=3 D HELP^DITC0 G Q15
        !            16:        I X'=1,X'=2 W $C(7),!,"Enter '1' or '2'" G Q15
        !            17:        S DDEF=X
        !            18: Q2     S %=2 W !!,"DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS" D YN^DICN I '% S DMSG=2 D HELP^DITC0 G Q2
        !            19:        S:%=1 DDIF=1 G:%<0 END G PRNT^DITC1
        !            20: EN     ;
        !            21:        D K2
        !            22: EN2    ;
        !            23:        D K1 S DMSG=0 F I="DFF","DIT(1)","DIT(2)" Q:DMSG  I '$D(@I) S DMSG=1,DMSG(1)=I
        !            24:        G:DMSG ERREND^DITC0 F I="DFF","DIT(1)","DIT(2)" Q:DMSG  I '$L(@I) S DMSG=2,DMSG(1)=I
        !            25:        G:DMSG ERREND^DITC0 I '$D(^DD(DFF)) S DMSG=3,DMSG(1)=DFF G ERREND^DITC0
        !            26:        S:'$D(DFL) N=$O(^DD(DFF,0,"NM",-1))_U,X1=1,M=DFF_U
        !            27:        S DITC=1,K=DFF,DSUB=0
        !            28:        F I=0:0 Q:'$D(^DD(K,0,"UP"))  S J=^("UP"),I=$O(^DD(J,"SB",K,-1)),DSUB=DSUB+1,DSUB(DSUB)=""""_$P($P(^DD(J,I,0),U,4),";",1)_""",",K=J S:'$D(DFL) N=N_$O(^DD(K,0,"NM",-1))_U,M=M_K_U,X1=X1+1
        !            29:        S DSUB=DSUB+1,DSUB(DSUB)=^DIC(K,0,"GL") I '$D(DFL) F DFL=1:1:X1 S DFL(DFL)=$P(N,U,X1-DFL+1),DFF(DFL)=$P(M,U,X1-DFL+1)
        !            30:        S DMSG="" F I=1:1:2 S DTO(I)="" I DIT(I)'=0 F K=DSUB:-1:1 S DTO(I)=DTO(I)_DSUB(K)_$P(DIT(I),",",DSUB-K+1)_"," I '$L($P(DIT(I),",",DSUB-K+1)) S DMSG=4,DMSG(1)="DIT("_I_")"
        !            31:        F I=1,2 I $L($P(DIT(I),",",DSUB+1,99)) S DMSG=4,DMSG(1)="DIT("_I_")"
        !            32:        G:$L(DMSG) ERREND^DITC0 K DMSG G PRNT^DITC1
        !            33: K1     ;
        !            34:        K %H,DSUB,DTO,DFL,DNUM
        !            35:        Q
        !            36: K2     ;
        !            37:        K D001,DHD,DUOUT,DTOUT,DIRUT,^UTILITY($J,"DIT"),^("DITI"),^("DITDINUM")
        !            38:        Q
        !            39: END    ;
        !            40:        I $D(DTOUT)!($D(DUOUT)) S DIRUT=1
        !            41:        D K1 K DIMERGE,DDSP,DDIF,DDEF,DIT,DFF,DDSH,DDSPC,DEQ,DIACT,X,X2,POP,DHD,D,Y,X1,^UTILITY($J,"DIT"),^("DITI"),^("DITDINUM")
        !            42:        K DITC
        !            43:        Q