- DITC3 ;SFISC/XAK-COMPARE FILE ENTRIES ;9/17/91 3:12 PM
- ;;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.
- ;
- F I=1:1:(IOSL-$Y-1) W !
- W "Enter RETURN to continue: " R X:DTIME S:'$T DTOUT=1
- ASK Q:$D(DTOUT) K DUOUT,DIRUT W @IOF,!,"OK. I'M READY TO DO THE MERGE."
- S DIR(0)="S^P:PROCEED to merge the data;S:SUMMARIZE the modifications before proceeding;E:EDIT the data again before proceeding"
- S DIR("A")="ACTION" D ^DIR K DIR
- Q:$D(DIRUT) I Y="E" D ^DITC2 Q:$D(DTOUT) G ASK:X=U,DITC3:$D(^UTILITY($J,"DIT",U)),ASK
- S DIACT=Y,DNUM=0 D ACT Q:DIACT="P" G:$D(DIRUT) ASK G DITC3
- ACT ;
- I DIACT="S" D SUMHD
- S DIT1="" F K=0:0 Q:$D(DTOUT) S DIT1=$O(^UTILITY($J,"DIT",DIT1)) Q:DIT1="" S DIT2="" F K=0:0 Q:$D(DTOUT) S DIT2=$O(^UTILITY($J,"DIT",DIT1,DIT2)) Q:DIT2="" S X(0)=^(DIT2,0),%=$P(X(0),U,3) I %,DDEF'=% D EACH
- W !!,?2,"NOTE: Multiples will be merged into the target record"
- K DIT1,DIT2 Q
- EACH ;
- I DIACT="S" G SUMEACH
- S DIE=DFF(1),DA=$P(DIT(DDEF),","),X2=$S($D(^UTILITY($J,"DITI",DIT1,DIT2,%)):^(%),'$D(^UTILITY($J,"DIT",DIT1,DIT2,%)):"@",1:^(%))
- S DR=+X(0)_"///"_X2 D ^DIE W "."
- K DR,DIE Q
- SUMHD ;
- W @IOF,!,"SUMMARY OF MODIFICATIONS TO ",$P(DHD(DFL),U,DDEF),!,"FIELD",?DV,$S(DDEF=1:"OLD",1:"NEW")," VALUE",?(DV*2),$S(DDEF=1:"NEW",1:"OLD")," VALUE",!,DDSH
- Q
- SUMEACH ;
- I $Y+5>IOSL K DIR S DIR(0)="E" D ^DIR K DIR Q:$D(DIRUT) D SUMHD
- K D S X2="",X(0)=$P(X(0),U,2) F I=1:1:2 S X(I)=$S($D(^UTILITY($J,"DIT",DIT1,DIT2,I)):^(I),1:"")
- D D20^DITC2
- Q
- --- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITC3 1743 printed Feb 19, 2025@00:20:25 Page 2
- DITC3 ;SFISC/XAK-COMPARE FILE ENTRIES ;9/17/91 3:12 PM
- +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 ;
- +7 FOR I=1:1:(IOSL-$Y-1)
- WRITE !
- +8 WRITE "Enter RETURN to continue: "
- READ X:DTIME
- if '$TEST
- SET DTOUT=1
- ASK if $DATA(DTOUT)
- QUIT
- KILL DUOUT,DIRUT
- WRITE @IOF,!,"OK. I'M READY TO DO THE MERGE."
- +1 SET DIR(0)="S^P:PROCEED to merge the data;S:SUMMARIZE the modifications before proceeding;E:EDIT the data again before proceeding"
- +2 SET DIR("A")="ACTION"
- DO ^DIR
- KILL DIR
- +3 if $DATA(DIRUT)
- QUIT
- IF Y="E"
- DO ^DITC2
- if $DATA(DTOUT)
- QUIT
- if X=U
- GOTO ASK
- if $DATA(^UTILITY($JOB,"DIT",U))
- GOTO DITC3
- GOTO ASK
- +4 SET DIACT=Y
- SET DNUM=0
- DO ACT
- if DIACT="P"
- QUIT
- if $DATA(DIRUT)
- GOTO ASK
- GOTO DITC3
- ACT ;
- +1 IF DIACT="S"
- DO SUMHD
- +2 SET DIT1=""
- FOR K=0:0
- if $DATA(DTOUT)
- QUIT
- SET DIT1=$ORDER(^UTILITY($JOB,"DIT",DIT1))
- if DIT1=""
- QUIT
- SET DIT2=""
- FOR K=0:0
- if $DATA(DTOUT)
- QUIT
- SET DIT2=$ORDER(^UTILITY($JOB,"DIT",DIT1,DIT2))
- if DIT2=""
- QUIT
- SET X(0)=^(DIT2,0)
- SET %=$PIECE(X(0),U,3)
- IF %
- IF DDEF'=%
- DO EACH
- +3 WRITE !!,?2,"NOTE: Multiples will be merged into the target record"
- +4 KILL DIT1,DIT2
- QUIT
- EACH ;
- +1 IF DIACT="S"
- GOTO SUMEACH
- +2 SET DIE=DFF(1)
- SET DA=$PIECE(DIT(DDEF),",")
- SET X2=$SELECT($DATA(^UTILITY($JOB,"DITI",DIT1,DIT2,%)):^(%),'$DATA(^UTILITY($JOB,"DIT",DIT1,DIT2,%)):"@",1:^(%))
- +3 SET DR=+X(0)_"///"_X2
- DO ^DIE
- WRITE "."
- +4 KILL DR,DIE
- QUIT
- SUMHD ;
- +1 WRITE @IOF,!,"SUMMARY OF MODIFICATIONS TO ",$PIECE(DHD(DFL),U,DDEF),!,"FIELD",?DV,$SELECT(DDEF=1:"OLD",1:"NEW")," VALUE",?(DV*2),$SELECT(DDEF=1:"NEW",1:"OLD")," VALUE",!,DDSH
- +2 QUIT
- SUMEACH ;
- +1 IF $Y+5>IOSL
- KILL DIR
- SET DIR(0)="E"
- DO ^DIR
- KILL DIR
- if $DATA(DIRUT)
- QUIT
- DO SUMHD
- +2 KILL D
- SET X2=""
- SET X(0)=$PIECE(X(0),U,2)
- FOR I=1:1:2
- SET X(I)=$SELECT($DATA(^UTILITY($JOB,"DIT",DIT1,DIT2,I)):^(I),1:"")
- +3 DO D20^DITC2
- +4 QUIT