Return to DITM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    1: DITM	;SFISC/JCM(OHPRD)-FILE COMPARE AND MERGE DRIVER ;6/8/94  14:21
    2: 	;;21.0;VA FileMan;;Dec 28, 1994
    3: 	;Per VHA Directive 10-93-142, this routine should not be modified.
    4: START	;
    5: 	D ASK ; Asks file, from, to, merge ,etc.
    6: 	G:$D(DITM("QFLG")) END
    7: 	D ^DITM2
    8: END	D EOJ ;----------->Cleanup
    9: 	Q  ;-------------->End of routine
   10: 	;--------------------------------------------------------------------
   11: 	;
   12: ASK	;
   13: 	D ASKX
   14: 	K DITM,%H,DSUB,DMSG,DTO,DFL,DNUM,DDON
   15: 	K D001,DHD,^UTILITY($J,"DIT")
   16: 	K DITM("QFLG")
   17: 	D T^DICRW
   18: 	I Y<0 S DITM("QFLG")="" G ASKX
   19: 	S (DSUB,DIT,L)=0,DSUB(L)=DIC,DITC=1
   20: 	D ^DITM1
   21: 	G:$D(DITM("QFLG")) ASKX
   22: 	G:'$D(DITM("DFF")) ASK
   23: Q1	;
   24: 	W ! K DIR
   25: 	D BLD^DIALOG(8086,"","","DIR(""A"")"),BLD^DIALOG(9041,"","","DIR(""?"")")
   26: 	S DIR(0)="YO",DIR("B")=$P($$EZBLD^DIALOG(7001),U,2)
   27: 	D ^DIR K DIR
   28: 	I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
   29: 	S:Y=1 DITM("DIMERGE")=1
   30: 	G:'$D(DITM("DIMERGE")) Q6
   31: 	W ! F I=1,2 W !?4,I,?10,DTO(I,"X")
   32: 	K X,Y
   33: Q2	;
   34: 	W !
   35: 	S DIR(0)="N^1:2:0",DIR("?")="^S DMSG=3 D HELP^DITC0"
   36: 	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 "
   37: 	D ^DIR K DIR
   38: 	I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
   39: 	I X'=2 S DITM("DIT(1)")=DIT(2),DITM("DIT(2)")=DIT(1)
   40: 	S DITM("DDEF")=2 W !,"   *** Records will be merged into "_DTO(X,"X"),!
   41: 	I X'=2
   42: 	K X,Y
   43: Q3	;
   44: 	W !
   45: 	S DIR(0)="Y"
   46: 	S DIR("A")="DO YOU WANT TO DELETE THE MERGED FROM ENTRY AFTER MERGING"
   47: 	S DIR("?")="If you enter NO the merged FROM entry will remain in this file"
   48: 	D ^DIR K DIR
   49: 	I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
   50: 	S:Y DITM("DELETE")=""
   51: 	K X,Y
   52: 	G:$D(DITM("SUB FILE")) Q6
   53: Q4	;
   54: 	W !
   55: 	S DIR(0)="Y"
   56: 	S DIR("A")="DO YOU WANT TO REPOINT ENTRIES POINTING TO THIS ENTRY"
   57: 	D ^DIR K DIR
   58: 	S:$D(DTOUT)!($D(DUOUT)) DITM("QFLG")=""
   59: 	G:$D(DTOUT)!($D(DUOUT)) ASKX
   60: 	S:Y DITM("REPOINT")=""
   61: 	G:'$D(DITM("REPOINT")) Q6
   62: 	K X,Y
   63: Q5	;
   64: 	W !
   65: 	S DIR(0)="PO^1:EMZ"
   66: 	S DIR("A")="ENTER FILE TO EXCLUDE FROM REPOINT/MERGE"
   67: 	S DIR("?")="Any file entered here will not be repointed or merged."
   68: 	F DITM=0:0 D ^DIR Q:$D(DIRUT)!(Y<1)  S DITM("EXCLUDE",+Y)=""
   69: 	K DIR
   70: 	I $D(DUOUT)!($D(DTOUT)) S DITM("QFLG")="" G ASKX
   71: 	K X,Y
   72: Q6	;
   73: 	W !
   74: 	S DIR(0)="YO",DIR("B")="NO"
   75: 	S DIR("A")="DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"
   76: 	S DIR("?")="^S DMSG=2 D HELP^DITC0"
   77: 	D ^DIR K DIR
   78: 	I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
   79: 	S:Y DITM("DDIF")=1
   80: 	K X,Y
   81: ASKX	;
   82: 	K DFL,DIC,DISYS,DITC,DSUB,I,X,Y,DIPGM,DMSG,%,DIR,DIT,DFF,DTO,DDSP
   83: 	Q
   84: EOJ	;
   85: 	K DITM,DMSG,DIRUT,L
   86: 	Q
   87: 	;8086 NOTE: This option should be used only during non-peak hours...
   88: 	;9041 If you merge two entries within a file that is pointed-to...
   89: 	;7001 Yes^No