DITM.m

DITM ;SFISC/JCM(OHPRD)-FILE COMPARE AND MERGE DRIVER ;6/8/94  14:21

 ;;22.0;VA FileMan;;Mar 30, 1999

 ;Per VHA Directive 10-93-142, this routine should not be modified.

START ;

 D ASK ; Asks file, from, to, merge ,etc.

 G:$D(DITM("QFLG")) END

 D ^DITM2

END D EOJ ;----------->Cleanup

 Q  ;-------------->End of routine

 ;--------------------------------------------------------------------

 ;

ASK ;

 D ASKX

 K DITM,%H,DSUB,DMSG,DTO,DFL,DNUM,DDON

 K D001,DHD,^UTILITY($J,"DIT")

 K DITM("QFLG")

 D T^DICRW

 I Y<0 S DITM("QFLG")="" G ASKX

 S (DSUB,DIT,L)=0,DSUB(L)=DIC,DITC=1

 D ^DITM1

 G:$D(DITM("QFLG")) ASKX

 G:'$D(DITM("DFF")) ASK

Q1 ;

 W ! K DIR

 D BLD^DIALOG(8086,"","","DIR(""A"")"),BLD^DIALOG(9041,"","","DIR(""?"")")

 S DIR(0)="YO",DIR("B")=$P($$EZBLD^DIALOG(7001),U,2)

 D ^DIR K DIR

 I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX

 S:Y=1 DITM("DIMERGE")=1

 G:'$D(DITM("DIMERGE")) Q6

 W ! F I=1,2 W !?4,I,?10,DTO(I,"X")

 K X,Y

Q2 ;

 W !

 S DIR(0)="N^1:2:0",DIR("?")="^S DMSG=3 D HELP^DITC0"

 S DIR("A",1)=" Note: Records will be merged into the entry selected for the default.",DIR("A")="WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES "

 D ^DIR K DIR

 I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX

 I X'=2 S DITM("DIT(1)")=DIT(2),DITM("DIT(2)")=DIT(1)

 S DITM("DDEF")=2 W !,"   *** Records will be merged into "_DTO(X,"X"),!

 I X'=2

 K X,Y

Q3 ;

 W !

 S DIR(0)="Y"

 S DIR("A")="DO YOU WANT TO DELETE THE MERGED FROM ENTRY AFTER MERGING"

 S DIR("?")="If you enter NO the merged FROM entry will remain in this file"

 D ^DIR K DIR

 I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX

 S:Y DITM("DELETE")=""

 K X,Y

 G:$D(DITM("SUB FILE")) Q6

Q4 ;

 W !

 S DIR(0)="Y"

 S DIR("A")="DO YOU WANT TO REPOINT ENTRIES POINTING TO THIS ENTRY"

 D ^DIR K DIR

 S:$D(DTOUT)!($D(DUOUT)) DITM("QFLG")=""

 G:$D(DTOUT)!($D(DUOUT)) ASKX

 S:Y DITM("REPOINT")=""

 G:'$D(DITM("REPOINT")) Q6

 K X,Y

Q5 ;

 W !

 S DIR(0)="PO^1:EMZ"

 S DIR("A")="ENTER FILE TO EXCLUDE FROM REPOINT/MERGE"

 S DIR("?")="Any file entered here will not be repointed or merged."

 F DITM=0:0 D ^DIR Q:$D(DIRUT)!(Y<1)  S DITM("EXCLUDE",+Y)=""

 K DIR

 I $D(DUOUT)!($D(DTOUT)) S DITM("QFLG")="" G ASKX

 K X,Y

Q6 ;

 W !

 S DIR(0)="YO",DIR("B")="NO"

 S DIR("A")="DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"

 S DIR("?")="^S DMSG=2 D HELP^DITC0"

 D ^DIR K DIR

 I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX

 S:Y DITM("DDIF")=1

 K X,Y

ASKX ;

 K DFL,DIC,DISYS,DITC,DSUB,I,X,Y,DIPGM,DMSG,%,DIR,DIT,DFF,DTO,DDSP

 Q

EOJ ;

 K DITM,DMSG,DIRUT,L

 Q

 ;8086 NOTE: This option should be used only during non-peak hours...

 ;9041 If you merge two entries within a file that is pointed-to...

 ;7001 Yes^No

DITM      ;SFISC/JCM(OHPRD)-FILE COMPARE AND MERGE DRIVER ;6/8/94  14:21

 +1       ;;22.0;VA FileMan;;Mar 30, 1999

 +2       ;Per VHA Directive 10-93-142, this routine should not be modified.

START     ;

 +1       ; Asks file, from, to, merge ,etc.

           DO ASK

 +2        IF $DATA(DITM("QFLG"))

               GOTO END

 +3        DO ^DITM2

END       ;----------->Cleanup

           DO EOJ

 +1       ;-------------->End of routine

           QUIT 

 +2       ;--------------------------------------------------------------------

 +3       ;

ASK       ;

 +1        DO ASKX

 +2        KILL DITM,%H,DSUB,DMSG,DTO,DFL,DNUM,DDON

 +3        KILL D001,DHD,^UTILITY($JOB,"DIT")

 +4        KILL DITM("QFLG")

 +5        DO T^DICRW

 +6        IF Y<0

               SET DITM("QFLG")=""

               GOTO ASKX

 +7        SET (DSUB,DIT,L)=0

           SET DSUB(L)=DIC

           SET DITC=1

 +8        DO ^DITM1

 +9        IF $DATA(DITM("QFLG"))

               GOTO ASKX

 +10       IF '$DATA(DITM("DFF"))

               GOTO ASK

Q1        ;

 +1        WRITE !

           KILL DIR

 +2        DO BLD^DIALOG(8086,"","","DIR(""A"")")

           DO BLD^DIALOG(9041,"","","DIR(""?"")")

 +3        SET DIR(0)="YO"

           SET DIR("B")=$PIECE($$EZBLD^DIALOG(7001),U,2)

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DITM("QFLG")=""

               GOTO ASKX

 +6        IF Y=1

               SET DITM("DIMERGE")=1

 +7        IF '$DATA(DITM("DIMERGE"))

               GOTO Q6

 +8        WRITE !

           FOR I=1,2

               WRITE !?4,I,?10,DTO(I,"X")

 +9        KILL X,Y

Q2        ;

 +1        WRITE !

 +2        SET DIR(0)="N^1:2:0"

           SET DIR("?")="^S DMSG=3 D HELP^DITC0"

 +3        SET DIR("A",1)=" Note: Records will be merged into the entry selected for the default."

           SET DIR("A")="WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES "

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DITM("QFLG")=""

               GOTO ASKX

 +6        IF X'=2

               SET DITM("DIT(1)")=DIT(2)

               SET DITM("DIT(2)")=DIT(1)

 +7        SET DITM("DDEF")=2

           WRITE !,"   *** Records will be merged into "_DTO(X,"X"),!

 +8        IF X'=2

 +9        KILL X,Y

Q3        ;

 +1        WRITE !

 +2        SET DIR(0)="Y"

 +3        SET DIR("A")="DO YOU WANT TO DELETE THE MERGED FROM ENTRY AFTER MERGING"

 +4        SET DIR("?")="If you enter NO the merged FROM entry will remain in this file"

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DITM("QFLG")=""

               GOTO ASKX

 +7        IF Y

               SET DITM("DELETE")=""

 +8        KILL X,Y

 +9        IF $DATA(DITM("SUB FILE"))

               GOTO Q6

Q4        ;

 +1        WRITE !

 +2        SET DIR(0)="Y"

 +3        SET DIR("A")="DO YOU WANT TO REPOINT ENTRIES POINTING TO THIS ENTRY"

 +4        DO ^DIR

           KILL DIR

 +5        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DITM("QFLG")=""

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))

               GOTO ASKX

 +7        IF Y

               SET DITM("REPOINT")=""

 +8        IF '$DATA(DITM("REPOINT"))

               GOTO Q6

 +9        KILL X,Y

Q5        ;

 +1        WRITE !

 +2        SET DIR(0)="PO^1:EMZ"

 +3        SET DIR("A")="ENTER FILE TO EXCLUDE FROM REPOINT/MERGE"

 +4        SET DIR("?")="Any file entered here will not be repointed or merged."

 +5        FOR DITM=0:0

               DO ^DIR

               IF $DATA(DIRUT)!(Y<1)

                   QUIT 

               SET DITM("EXCLUDE",+Y)=""

 +6        KILL DIR

 +7        IF $DATA(DUOUT)!($DATA(DTOUT))

               SET DITM("QFLG")=""

               GOTO ASKX

 +8        KILL X,Y

Q6        ;

 +1        WRITE !

 +2        SET DIR(0)="YO"

           SET DIR("B")="NO"

 +3        SET DIR("A")="DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"

 +4        SET DIR("?")="^S DMSG=2 D HELP^DITC0"

 +5        DO ^DIR

           KILL DIR

 +6        IF $DATA(DTOUT)!($DATA(DUOUT))

               SET DITM("QFLG")=""

               GOTO ASKX

 +7        IF Y

               SET DITM("DDIF")=1

 +8        KILL X,Y

ASKX      ;

 +1        KILL DFL,DIC,DISYS,DITC,DSUB,I,X,Y,DIPGM,DMSG,%,DIR,DIT,DFF,DTO,DDSP

 +2        QUIT 

EOJ       ;

 +1        KILL DITM,DMSG,DIRUT,L

 +2        QUIT 

 +3       ;8086 NOTE: This option should be used only during non-peak hours...

 +4       ;9041 If you merge two entries within a file that is pointed-to...

 +5       ;7001 Yes^No