Return to DITM2.m CVS log

Up to [Coherent Logic Development] / freem_fileman / USER

Restructure repository

    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