- 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 Jan 18, 2025@03:55:17 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