Return to DITM.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Annotation of freem_fileman/USER/DITM.m, revision 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