Return to DITM.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITM.m, revision 1.1.1.1

1.1       snw         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