| [613] | 1 | DITM2 ;SFISC/JCM(OHPRD)-DOES COMPARE AND MERGE ;11/18/94 15:42
|
|---|
| 2 | ;;22.0;VA FileMan;;Mar 30, 1999
|
|---|
| 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
|
|---|
