DITC ;SFISC/XAK-MERGE OR COMPARE ENTRIES ;9/17/91 10:36 AM
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
START ;
K DFF,DIT,DIMERGE,DDSP,DDIF,DDEF,DITC,DMSG
D K2,K1,T^DICRW G:Y<0 END S (DSUB,DIT,L)=0,DSUB(L)=DIC,DITC=1
SUB S %=$P(Y,U,2),Y=+Y D SUB^DICRW K DIA
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 !
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)
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
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
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
S:%=1 DIMERGE=1 G:%<0 END G:'$D(DIMERGE) Q2 W ! F I=1,2 W !?5,I,?10,DTO(I,"X")
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
I X'=1,X'=2 W $C(7),!,"Enter '1' or '2'" G Q15
S DDEF=X
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
S:%=1 DDIF=1 G:%<0 END G PRNT^DITC1
EN ;
D K2
EN2 ;
D K1 S DMSG=0 F I="DFF","DIT(1)","DIT(2)" Q:DMSG I '$D(@I) S DMSG=1,DMSG(1)=I
G:DMSG ERREND^DITC0 F I="DFF","DIT(1)","DIT(2)" Q:DMSG I '$L(@I) S DMSG=2,DMSG(1)=I
G:DMSG ERREND^DITC0 I '$D(^DD(DFF)) S DMSG=3,DMSG(1)=DFF G ERREND^DITC0
S:'$D(DFL) N=$O(^DD(DFF,0,"NM",-1))_U,X1=1,M=DFF_U
S DITC=1,K=DFF,DSUB=0
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
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)
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_")"
F I=1,2 I $L($P(DIT(I),",",DSUB+1,99)) S DMSG=4,DMSG(1)="DIT("_I_")"
G:$L(DMSG) ERREND^DITC0 K DMSG G PRNT^DITC1
K1 ;
K %H,DSUB,DTO,DFL,DNUM
Q
K2 ;
K D001,DHD,DUOUT,DTOUT,DIRUT,^UTILITY($J,"DIT"),^("DITI"),^("DITDINUM")
Q
END ;
I $D(DTOUT)!($D(DUOUT)) S DIRUT=1
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")
K DITC
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITC 2935 printed Dec 13, 2024@02:54:07 Page 2
DITC ;SFISC/XAK-MERGE OR COMPARE ENTRIES ;9/17/91 10:36 AM
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
START ;
+1 KILL DFF,DIT,DIMERGE,DDSP,DDIF,DDEF,DITC,DMSG
+2 DO K2
DO K1
DO T^DICRW
if Y<0
GOTO END
SET (DSUB,DIT,L)=0
SET DSUB(L)=DIC
SET DITC=1
SUB SET %=$PIECE(Y,U,2)
SET Y=+Y
DO SUB^DICRW
KILL DIA
ENTR if X["^"!($DATA(DTOUT))
GOTO END
KILL DIC
SET DIC(0)="AEQMZ"
SET DIC=DSUB(0)
SET DFL=1
SET DIT=DIT+1
SET DIT(DIT)=""
if DIT=1
WRITE !
E1 SET DIC("A")=$EXTRACT(" ",1,DFL-1*3)_$SELECT(DIT=2:" WITH ",1:"COMPARE ")_DFL(DFL)_": "
IF (DIT=2)
IF (DFL=L)
IF ($PIECE(DIT(1),",",1,L-1)=$PIECE(DIT(2),",",1,L-1))
SET DIC("S")="I Y-"_$PIECE(DIT(1),",",L)
+1 DO ^DIC
KILL DIC("S"),DIC("A")
IF Y>0
IF $DATA(DSUB(DFL))
IF $DATA(DFL(DFL+1))
SET DIC=DIC_+Y_","_DSUB(DFL)
SET DIT(DIT)=DIT(DIT)_+Y_","
SET DFL=DFL+1
SET %=$ORDER(@(DIC_"-1)"))
if '%
GOTO E1
if %>0
SET ^(0)=U_DFF_U
IF %<0
WRITE !,"NO "_DFL(DFL)
SET Y=-1
+2 if X=U
GOTO END
if Y=-1
GOTO START
SET DTO(DIT)=DIC_+Y_","
SET DTO(DIT,"X")=Y(0,0)
SET DIT(DIT)=DIT(DIT)_+Y
if DIT=1
GOTO ENTR
SET DDSP=1
Q1 SET %=2
WRITE !!,"WILL YOU WANT TO MERGE THESE ENTRIES AFTER COMPARING THEM"
DO YN^DICN
IF '%
WRITE !
SET DMSG=1
DO HELP^DITC0
GOTO Q1
+1 if %=1
SET DIMERGE=1
if %<0
GOTO END
if '$DATA(DIMERGE)
GOTO Q2
WRITE !
FOR I=1,2
WRITE !?5,I,?10,DTO(I,"X")
Q15 READ !!,"WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES (1 OR 2)? ",X:DTIME
if X[U
SET DUOUT=1
if '$TEST
SET X=U
SET DTOUT=1
if X["^"
GOTO END
IF X="?"
SET DMSG=3
DO HELP^DITC0
GOTO Q15
+1 IF X'=1
IF X'=2
WRITE $CHAR(7),!,"Enter '1' or '2'"
GOTO Q15
+2 SET DDEF=X
Q2 SET %=2
WRITE !!,"DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"
DO YN^DICN
IF '%
SET DMSG=2
DO HELP^DITC0
GOTO Q2
+1 if %=1
SET DDIF=1
if %<0
GOTO END
GOTO PRNT^DITC1
EN ;
+1 DO K2
EN2 ;
+1 DO K1
SET DMSG=0
FOR I="DFF","DIT(1)","DIT(2)"
if DMSG
QUIT
IF '$DATA(@I)
SET DMSG=1
SET DMSG(1)=I
+2 if DMSG
GOTO ERREND^DITC0
FOR I="DFF","DIT(1)","DIT(2)"
if DMSG
QUIT
IF '$LENGTH(@I)
SET DMSG=2
SET DMSG(1)=I
+3 if DMSG
GOTO ERREND^DITC0
IF '$DATA(^DD(DFF))
SET DMSG=3
SET DMSG(1)=DFF
GOTO ERREND^DITC0
+4 if '$DATA(DFL)
SET N=$ORDER(^DD(DFF,0,"NM",-1))_U
SET X1=1
SET M=DFF_U
+5 SET DITC=1
SET K=DFF
SET DSUB=0
+6 FOR I=0:0
if '$DATA(^DD(K,0,"UP"))
QUIT
SET J=^("UP")
SET I=$ORDER(^DD(J,"SB",K,-1))
SET DSUB=DSUB+1
SET DSUB(DSUB)=""""_$PIECE($PIECE(^DD(J,I,0),U,4),";",1)_""","
SET K=J
if '$DATA(DFL)
SET N=N_$ORDER(^DD(K,0,"NM",-1))_U
SET M=M_K_U
SET X1=X1+1
+7 SET DSUB=DSUB+1
SET DSUB(DSUB)=^DIC(K,0,"GL")
IF '$DATA(DFL)
FOR DFL=1:1:X1
SET DFL(DFL)=$PIECE(N,U,X1-DFL+1)
SET DFF(DFL)=$PIECE(M,U,X1-DFL+1)
+8 SET DMSG=""
FOR I=1:1:2
SET DTO(I)=""
IF DIT(I)'=0
FOR K=DSUB:-1:1
SET DTO(I)=DTO(I)_DSUB(K)_$PIECE(DIT(I),",",DSUB-K+1)_","
IF '$LENGTH($PIECE(DIT(I),",",DSUB-K+1))
SET DMSG=4
SET DMSG(1)="DIT("_I_")"
+9 FOR I=1,2
IF $LENGTH($PIECE(DIT(I),",",DSUB+1,99))
SET DMSG=4
SET DMSG(1)="DIT("_I_")"
+10 if $LENGTH(DMSG)
GOTO ERREND^DITC0
KILL DMSG
GOTO PRNT^DITC1
K1 ;
+1 KILL %H,DSUB,DTO,DFL,DNUM
+2 QUIT
K2 ;
+1 KILL D001,DHD,DUOUT,DTOUT,DIRUT,^UTILITY($JOB,"DIT"),^("DITI"),^("DITDINUM")
+2 QUIT
END ;
+1 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DIRUT=1
+2 DO K1
KILL DIMERGE,DDSP,DDIF,DDEF,DIT,DFF,DDSH,DDSPC,DEQ,DIACT,X,X2,POP,DHD,D,Y,X1,^UTILITY($JOB,"DIT"),^("DITI"),^("DITDINUM")
+3 KILL DITC
+4 QUIT
