Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: DITM2

DITM2.m

Go to the documentation of this file.
  1. DITM2 ;SFISC/JCM(OHPRD)-DOES COMPARE AND MERGE ;11/18/94 15:42
  1. ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
  1. ;;Per VA Directive 6402, this routine should not be modified.
  1. ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
  1. ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
  1. ;;Licensed under the terms of the Apache License, Version 2.0.
  1. ;
  1. ; See DITMDOC for documentation
  1. ; Subfiles are not currently supported by the call to EN^DITM2
  1. ; until DITC can handle them.
  1. ;-------------------------------------------------------------------
  1. START ;
  1. EN ; Entry point
  1. L +@(DITM("DIC")_$P(DITM("DIT(1)"),",",1)_")")
  1. L +@(DITM("DIC")_$P(DITM("DIT(2)"),",",1)_")")
  1. K DMSG,DIRUT
  1. D:'$D(DITM("NON-INTERACTIVE")) DITC ; --->Sets up and calls DITC
  1. I $D(DMSG)!($D(DIRUT)) S DITM("QFLG")="" G END
  1. G:'$D(DITM("DIMERGE")) END
  1. D:'$D(DITM("SUB FILE")) DIT0 ; --->Sets up and calls DIT0
  1. D:$D(DITM("REPOINT"))&('$D(DITM("SUB FILE"))) REPOINT ;---->Merges
  1. ;---------------->other files that affect patient merge
  1. G:$D(DITM("QFLG")) END
  1. D:$D(DITM("DELETE")) DELETE ;----->Deletes MERGED entry
  1. END L -@(DITM("DIC")_$P(DITM("DIT(1)"),",",1)_")")
  1. L -@(DITM("DIC")_$P(DITM("DIT(2)"),",",1)_")")
  1. D EOJ ;----------->Cleanup
  1. Q ;-------------->End of routine
  1. ;----------------------------------------------------------------------
  1. DITC ;
  1. ;***Will need to add set up for subfiles when it works******
  1. ;
  1. K DFF,DIT,DIMERGE,DDIF,DDEF,DDSP
  1. S DFF=DITM("DFF"),DIT(1)=DITM("DIT(1)"),DIT(2)=DITM("DIT(2)"),DIC=DITM("DIC")
  1. S:$D(DITM("DIMERGE")) DIMERGE=1
  1. S:$D(DITM("DDIF")) DDIF=DITM("DDIF")
  1. S:$D(DITM("DDEF")) DDEF=DITM("DDEF")
  1. S:$D(DITM("DDSP")) DDSP=1
  1. D EN^DITC
  1. K DFF,DIT,DIMERGE,DDIF,DDEF,DDSP
  1. Q
  1. DIT0 ;
  1. W:'$D(DITM("NOTALK")) !!,"I will now merge all subfiles in this file ...",!,"This may take some time, please be patient."
  1. K DA
  1. S (DIT("T"),DIT("F"))=DITM("DIC")
  1. S (D0,DA("T"))=DITM("DIT(2)"),DA("F")=DITM("DIT(1)")
  1. D EN^DIT0 K D0,DA,DIC,DIK,DIT
  1. Q
  1. REPOINT ;
  1. S DITMGMQF=0
  1. S:$D(DITM("NON-INTERACTIVE")) DITMGMRG("NOTALK")=1
  1. S:$D(DITM("PACKAGE")) DITMGMRG("PACKAGE")=DITM("PACKAGE")
  1. W:'$D(DITM("NOTALK")) !!,"I will now repoint all files that point to this entry ...",!,"This may take some time, please be patient."
  1. S DITMGMRG("FILE")=DITM("DFF"),DITMGMRG("FR")=DITM("DIT(1)"),DITMGMRG("TO")=DITM("DIT(2)")
  1. S:$D(DITM("NOTALK")) DITMGMRG("NOTALK")=""
  1. I $D(DITM("EXCLUDE")) F DITMI=0:0 S DITMI=$O(DITM("EXCLUDE",DITMI)) Q:'DITMI S DITMGMRG("EXCLUDE",DITMI)=""
  1. D EN^DITMGMRG
  1. K DITMGMRG,DITMGMQF,DITMI
  1. Q
  1. DELETE ;
  1. W:'$D(DITM("NOTALK")) !,"Deleting From entry"
  1. I $D(DITM("SUB FILE")) D DELSUB G DELETEX
  1. S DIK=DITM("DIC"),DA=DITM("DIT(1)") D ^DIK K DA,DIK
  1. DELETEX Q
  1. ;
  1. DELSUB ;
  1. S DA(1)=$P(DITM("DIT(1)"),",",1),DA=$P(DITM("DIT(1)"),",",2)
  1. S DIK=DITM("DIC")_DA(1)_","_DITM("DSUB1")_"," D ^DIK K DA,DIK
  1. Q
  1. EOJ ;
  1. K DITM2,APMMD,DIC,X,Y
  1. Q