DITMGM1 ;SFISC/EDE(OHPRD)-INTERACTIVE MERGE ;Jan 05, 2015
;;22.2;VA FileMan;;Jan 05, 2016;Build 42
;;Per VA Directive 6402, this routine should not be modified.
;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
;;Licensed under the terms of the Apache License, Version 2.0.
;
START ;
K DITMGMRG
S DITMGMRG("GO")=0
S DIC=1,DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S DITMGMRG("FILE")=+Y
S DIC=DITMGMRG("FILE"),DIC(0)="AEMQ",DIC("A")="From entry: " D ^DIC K DIC
Q:Y<0
S DITMGMRG("FR")=+Y
S DIC=DITMGMRG("FILE"),DIC(0)="AEMQ",DIC("A")="To entry: " D ^DIC K DIC
Q:Y<0
S DITMGMRG("TO")=+Y
I DITMGMRG("FR")=DITMGMRG("TO") W !!,"From entry same as to entry!",!,$C(7) Q
S DIC=1,DIC(0)="AEMQ",DIC("A")="Enter file to exclude from merge: " F D ^DIC Q:Y<1 S DITMGMRG("EXCLUDE",+Y)=""
K DIC
S DIR(0)="Y",DIR("A")="Exclude files in affected packages",DIR("B")="NO"
S DIR("?",1)="This routine normally relinks/merges all files. Do you want to exclude"
S DIR("?")="files that are part of a package that has its own merge routine?"
D ^DIR K DIR
Q:$D(DIRUT)
I Y S DITMGMRG("PACKAGE")="",DITMGMRG("GO")=1 Q
S DIR(0)="Y",DIR("A")="Merge only files in a specific package?",DIR("B")="NO"
S DIR("?",1)="If you say NO you will merge all files pointing to the primary file."
S DIR("?",2)="If you say YES you will be asked for a package file entry and only"
S DIR("?")="merge the files in that package that point to the primary file."
D ^DIR K DIR
Q:$D(DIRUT)
I 'Y S DITMGMRG("GO")=1 Q
S DIC=9.4,DIC(0)="AEMQ" D ^DIC K DIC
Q:Y<0
S DITMGMRG("PACKAGE")=+Y
S DITMGMRG("GO")=1
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITMGM1 1702 printed Nov 22, 2024@18:04:15 Page 2
DITMGM1 ;SFISC/EDE(OHPRD)-INTERACTIVE MERGE ;Jan 05, 2015
+1 ;;22.2;VA FileMan;;Jan 05, 2016;Build 42
+2 ;;Per VA Directive 6402, this routine should not be modified.
+3 ;;Submitted to OSEHRA 5 January 2015 by the VISTA Expertise Network.
+4 ;;Based on Medsphere Systems Corporation's MSC FileMan 1051.
+5 ;;Licensed under the terms of the Apache License, Version 2.0.
+6 ;
START ;
+1 KILL DITMGMRG
+2 SET DITMGMRG("GO")=0
+3 SET DIC=1
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+4 if Y<0
QUIT
+5 SET DITMGMRG("FILE")=+Y
+6 SET DIC=DITMGMRG("FILE")
SET DIC(0)="AEMQ"
SET DIC("A")="From entry: "
DO ^DIC
KILL DIC
+7 if Y<0
QUIT
+8 SET DITMGMRG("FR")=+Y
+9 SET DIC=DITMGMRG("FILE")
SET DIC(0)="AEMQ"
SET DIC("A")="To entry: "
DO ^DIC
KILL DIC
+10 if Y<0
QUIT
+11 SET DITMGMRG("TO")=+Y
+12 IF DITMGMRG("FR")=DITMGMRG("TO")
WRITE !!,"From entry same as to entry!",!,$CHAR(7)
QUIT
+13 SET DIC=1
SET DIC(0)="AEMQ"
SET DIC("A")="Enter file to exclude from merge: "
FOR
DO ^DIC
if Y<1
QUIT
SET DITMGMRG("EXCLUDE",+Y)=""
+14 KILL DIC
+15 SET DIR(0)="Y"
SET DIR("A")="Exclude files in affected packages"
SET DIR("B")="NO"
+16 SET DIR("?",1)="This routine normally relinks/merges all files. Do you want to exclude"
+17 SET DIR("?")="files that are part of a package that has its own merge routine?"
+18 DO ^DIR
KILL DIR
+19 if $DATA(DIRUT)
QUIT
+20 IF Y
SET DITMGMRG("PACKAGE")=""
SET DITMGMRG("GO")=1
QUIT
+21 SET DIR(0)="Y"
SET DIR("A")="Merge only files in a specific package?"
SET DIR("B")="NO"
+22 SET DIR("?",1)="If you say NO you will merge all files pointing to the primary file."
+23 SET DIR("?",2)="If you say YES you will be asked for a package file entry and only"
+24 SET DIR("?")="merge the files in that package that point to the primary file."
+25 DO ^DIR
KILL DIR
+26 if $DATA(DIRUT)
QUIT
+27 IF 'Y
SET DITMGMRG("GO")=1
QUIT
+28 SET DIC=9.4
SET DIC(0)="AEMQ"
DO ^DIC
KILL DIC
+29 if Y<0
QUIT
+30 SET DITMGMRG("PACKAGE")=+Y
+31 SET DITMGMRG("GO")=1
+32 QUIT
