Return to DITM2.m CVS log

Up to [Coherent Logic Development] / freem_fileman

Annotation of freem_fileman/DITM2.m, revision 1.1

1.1     ! snw         1: DITM2  ;SFISC/JCM(OHPRD)-DOES COMPARE AND MERGE ;11/18/94  15:42
        !             2:        ;;21.0;VA FileMan;;Dec 28, 1994
        !             3:        ;Per VHA Directive 10-93-142, this routine should not be modified.
        !             4:        ;
        !             5:        ; See DITMDOC for documentation
        !             6:        ; Subfiles are not currently supported by the call to EN^DITM2
        !             7:        ; until DITC can handle them.
        !             8:        ;-------------------------------------------------------------------
        !             9: START  ;
        !            10: EN     ; Entry point
        !            11:        L +@(DITM("DIC")_$P(DITM("DIT(1)"),",",1)_")")
        !            12:        L +@(DITM("DIC")_$P(DITM("DIT(2)"),",",1)_")")
        !            13:        K DMSG,DIRUT
        !            14:        D:'$D(DITM("NON-INTERACTIVE")) DITC ; --->Sets up and calls DITC
        !            15:        I $D(DMSG)!($D(DIRUT)) S DITM("QFLG")="" G END
        !            16:        G:'$D(DITM("DIMERGE")) END
        !            17:        D:'$D(DITM("SUB FILE")) DIT0 ; --->Sets up and calls DIT0
        !            18:        D:$D(DITM("REPOINT"))&('$D(DITM("SUB FILE"))) REPOINT ;---->Merges
        !            19:        ;---------------->other files that affect patient merge
        !            20:        G:$D(DITM("QFLG")) END
        !            21:        D:$D(DITM("DELETE")) DELETE ;----->Deletes MERGED entry
        !            22: END    L -@(DITM("DIC")_$P(DITM("DIT(1)"),",",1)_")")
        !            23:        L -@(DITM("DIC")_$P(DITM("DIT(2)"),",",1)_")")
        !            24:        D EOJ ;----------->Cleanup
        !            25:        Q  ;-------------->End of routine
        !            26:        ;----------------------------------------------------------------------
        !            27: DITC   ;
        !            28:        ;***Will need to add set up for subfiles when it works******
        !            29:        ;
        !            30:        K DFF,DIT,DIMERGE,DDIF,DDEF,DDSP
        !            31:        S DFF=DITM("DFF"),DIT(1)=DITM("DIT(1)"),DIT(2)=DITM("DIT(2)"),DIC=DITM("DIC")
        !            32:        S:$D(DITM("DIMERGE")) DIMERGE=1
        !            33:        S:$D(DITM("DDIF")) DDIF=DITM("DDIF")
        !            34:        S:$D(DITM("DDEF")) DDEF=DITM("DDEF")
        !            35:        S:$D(DITM("DDSP")) DDSP=1
        !            36:        D EN^DITC
        !            37:        K DFF,DIT,DIMERGE,DDIF,DDEF,DDSP
        !            38:        Q
        !            39: DIT0   ;
        !            40:        W:'$D(DITM("NOTALK")) !!,"I will now merge all subfiles in this file ...",!,"This may take some time, please be patient."
        !            41:        K DA
        !            42:        S (DIT("T"),DIT("F"))=DITM("DIC")
        !            43:        S (D0,DA("T"))=DITM("DIT(2)"),DA("F")=DITM("DIT(1)")
        !            44:        D EN^DIT0 K D0,DA,DIC,DIK,DIT
        !            45:        Q
        !            46: REPOINT        ;
        !            47:        S DITMGMQF=0
        !            48:        S:$D(DITM("NON-INTERACTIVE")) DITMGMRG("NOTALK")=1
        !            49:        S:$D(DITM("PACKAGE")) DITMGMRG("PACKAGE")=DITM("PACKAGE")
        !            50:        W:'$D(DITM("NOTALK")) !!,"I will now repoint all files that point to this entry ...",!,"This may take some time, please be patient."
        !            51:        S DITMGMRG("FILE")=DITM("DFF"),DITMGMRG("FR")=DITM("DIT(1)"),DITMGMRG("TO")=DITM("DIT(2)")
        !            52:        S:$D(DITM("NOTALK")) DITMGMRG("NOTALK")=""
        !            53:        I $D(DITM("EXCLUDE")) F DITMI=0:0 S DITMI=$O(DITM("EXCLUDE",DITMI)) Q:'DITMI  S DITMGMRG("EXCLUDE",DITMI)=""
        !            54:        D EN^DITMGMRG
        !            55:        K DITMGMRG,DITMGMQF,DITMI
        !            56:        Q
        !            57: DELETE ;
        !            58:        W:'$D(DITM("NOTALK")) !,"Deleting From entry"
        !            59:        I $D(DITM("SUB FILE")) D DELSUB G DELETEX
        !            60:        S DIK=DITM("DIC"),DA=DITM("DIT(1)") D ^DIK K DA,DIK
        !            61: DELETEX        Q
        !            62:        ;
        !            63: DELSUB ;
        !            64:        S DA(1)=$P(DITM("DIT(1)"),",",1),DA=$P(DITM("DIT(1)"),",",2)
        !            65:        S DIK=DITM("DIC")_DA(1)_","_DITM("DSUB1")_"," D ^DIK K DA,DIK
        !            66:        Q
        !            67: EOJ    ;
        !            68:        K DITM2,APMMD,DIC,X,Y
        !            69:        Q