DITM ;SFISC/JCM(OHPRD)-FILE COMPARE AND MERGE DRIVER ;6/8/94 14:21
;;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 ;
D ASK ; Asks file, from, to, merge ,etc.
G:$D(DITM("QFLG")) END
D ^DITM2
END D EOJ ;----------->Cleanup
Q ;-------------->End of routine
;--------------------------------------------------------------------
;
ASK ;
D ASKX
K DITM,%H,DSUB,DMSG,DTO,DFL,DNUM,DDON
K D001,DHD,^UTILITY($J,"DIT")
K DITM("QFLG")
D T^DICRW
I Y<0 S DITM("QFLG")="" G ASKX
S (DSUB,DIT,L)=0,DSUB(L)=DIC,DITC=1
D ^DITM1
G:$D(DITM("QFLG")) ASKX
G:'$D(DITM("DFF")) ASK
Q1 ;
W ! K DIR
D BLD^DIALOG(8086,"","","DIR(""A"")"),BLD^DIALOG(9041,"","","DIR(""?"")")
S DIR(0)="YO",DIR("B")=$P($$EZBLD^DIALOG(7001),U,2)
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
S:Y=1 DITM("DIMERGE")=1
G:'$D(DITM("DIMERGE")) Q6
W ! F I=1,2 W !?4,I,?10,DTO(I,"X")
K X,Y
Q2 ;
W !
S DIR(0)="N^1:2:0",DIR("?")="^S DMSG=3 D HELP^DITC0"
S DIR("A",1)=" Note: Records will be merged into the entry selected for the default.",DIR("A")="WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES "
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
I X'=2 S DITM("DIT(1)")=DIT(2),DITM("DIT(2)")=DIT(1)
S DITM("DDEF")=2 W !," *** Records will be merged into "_DTO(X,"X"),!
I X'=2
K X,Y
Q3 ;
W !
S DIR(0)="Y"
S DIR("A")="DO YOU WANT TO DELETE THE MERGED FROM ENTRY AFTER MERGING"
S DIR("?")="If you enter NO the merged FROM entry will remain in this file"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
S:Y DITM("DELETE")=""
K X,Y
G:$D(DITM("SUB FILE")) Q6
Q4 ;
W !
S DIR(0)="Y"
S DIR("A")="DO YOU WANT TO REPOINT ENTRIES POINTING TO THIS ENTRY"
D ^DIR K DIR
S:$D(DTOUT)!($D(DUOUT)) DITM("QFLG")=""
G:$D(DTOUT)!($D(DUOUT)) ASKX
S:Y DITM("REPOINT")=""
G:'$D(DITM("REPOINT")) Q6
K X,Y
Q5 ;
W !
S DIR(0)="PO^1:EMZ"
S DIR("A")="ENTER FILE TO EXCLUDE FROM REPOINT/MERGE"
S DIR("?")="Any file entered here will not be repointed or merged."
F DITM=0:0 D ^DIR Q:$D(DIRUT)!(Y<1) S DITM("EXCLUDE",+Y)=""
K DIR
I $D(DUOUT)!($D(DTOUT)) S DITM("QFLG")="" G ASKX
K X,Y
Q6 ;
W !
S DIR(0)="YO",DIR("B")="NO"
S DIR("A")="DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"
S DIR("?")="^S DMSG=2 D HELP^DITC0"
D ^DIR K DIR
I $D(DTOUT)!($D(DUOUT)) S DITM("QFLG")="" G ASKX
S:Y DITM("DDIF")=1
K X,Y
ASKX ;
K DFL,DIC,DISYS,DITC,DSUB,I,X,Y,DIPGM,DMSG,%,DIR,DIT,DFF,DTO,DDSP
Q
EOJ ;
K DITM,DMSG,DIRUT,L
Q
;8086 NOTE: This option should be used only during non-peak hours...
;9041 If you merge two entries within a file that is pointed-to...
;7001 Yes^No
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HDITM 2946 printed Oct 16, 2024@18:54:48 Page 2
DITM ;SFISC/JCM(OHPRD)-FILE COMPARE AND MERGE DRIVER ;6/8/94 14:21
+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 ; Asks file, from, to, merge ,etc.
DO ASK
+2 if $DATA(DITM("QFLG"))
GOTO END
+3 DO ^DITM2
END ;----------->Cleanup
DO EOJ
+1 ;-------------->End of routine
QUIT
+2 ;--------------------------------------------------------------------
+3 ;
ASK ;
+1 DO ASKX
+2 KILL DITM,%H,DSUB,DMSG,DTO,DFL,DNUM,DDON
+3 KILL D001,DHD,^UTILITY($JOB,"DIT")
+4 KILL DITM("QFLG")
+5 DO T^DICRW
+6 IF Y<0
SET DITM("QFLG")=""
GOTO ASKX
+7 SET (DSUB,DIT,L)=0
SET DSUB(L)=DIC
SET DITC=1
+8 DO ^DITM1
+9 if $DATA(DITM("QFLG"))
GOTO ASKX
+10 if '$DATA(DITM("DFF"))
GOTO ASK
Q1 ;
+1 WRITE !
KILL DIR
+2 DO BLD^DIALOG(8086,"","","DIR(""A"")")
DO BLD^DIALOG(9041,"","","DIR(""?"")")
+3 SET DIR(0)="YO"
SET DIR("B")=$PIECE($$EZBLD^DIALOG(7001),U,2)
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DITM("QFLG")=""
GOTO ASKX
+6 if Y=1
SET DITM("DIMERGE")=1
+7 if '$DATA(DITM("DIMERGE"))
GOTO Q6
+8 WRITE !
FOR I=1,2
WRITE !?4,I,?10,DTO(I,"X")
+9 KILL X,Y
Q2 ;
+1 WRITE !
+2 SET DIR(0)="N^1:2:0"
SET DIR("?")="^S DMSG=3 D HELP^DITC0"
+3 SET DIR("A",1)=" Note: Records will be merged into the entry selected for the default."
SET DIR("A")="WHICH ENTRY SHOULD BE USED FOR DEFAULT VALUES "
+4 DO ^DIR
KILL DIR
+5 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DITM("QFLG")=""
GOTO ASKX
+6 IF X'=2
SET DITM("DIT(1)")=DIT(2)
SET DITM("DIT(2)")=DIT(1)
+7 SET DITM("DDEF")=2
WRITE !," *** Records will be merged into "_DTO(X,"X"),!
+8 IF X'=2
+9 KILL X,Y
Q3 ;
+1 WRITE !
+2 SET DIR(0)="Y"
+3 SET DIR("A")="DO YOU WANT TO DELETE THE MERGED FROM ENTRY AFTER MERGING"
+4 SET DIR("?")="If you enter NO the merged FROM entry will remain in this file"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DITM("QFLG")=""
GOTO ASKX
+7 if Y
SET DITM("DELETE")=""
+8 KILL X,Y
+9 if $DATA(DITM("SUB FILE"))
GOTO Q6
Q4 ;
+1 WRITE !
+2 SET DIR(0)="Y"
+3 SET DIR("A")="DO YOU WANT TO REPOINT ENTRIES POINTING TO THIS ENTRY"
+4 DO ^DIR
KILL DIR
+5 if $DATA(DTOUT)!($DATA(DUOUT))
SET DITM("QFLG")=""
+6 if $DATA(DTOUT)!($DATA(DUOUT))
GOTO ASKX
+7 if Y
SET DITM("REPOINT")=""
+8 if '$DATA(DITM("REPOINT"))
GOTO Q6
+9 KILL X,Y
Q5 ;
+1 WRITE !
+2 SET DIR(0)="PO^1:EMZ"
+3 SET DIR("A")="ENTER FILE TO EXCLUDE FROM REPOINT/MERGE"
+4 SET DIR("?")="Any file entered here will not be repointed or merged."
+5 FOR DITM=0:0
DO ^DIR
if $DATA(DIRUT)!(Y<1)
QUIT
SET DITM("EXCLUDE",+Y)=""
+6 KILL DIR
+7 IF $DATA(DUOUT)!($DATA(DTOUT))
SET DITM("QFLG")=""
GOTO ASKX
+8 KILL X,Y
Q6 ;
+1 WRITE !
+2 SET DIR(0)="YO"
SET DIR("B")="NO"
+3 SET DIR("A")="DO YOU WANT TO DISPLAY ONLY THE DISCREPANT FIELDS"
+4 SET DIR("?")="^S DMSG=2 D HELP^DITC0"
+5 DO ^DIR
KILL DIR
+6 IF $DATA(DTOUT)!($DATA(DUOUT))
SET DITM("QFLG")=""
GOTO ASKX
+7 if Y
SET DITM("DDIF")=1
+8 KILL X,Y
ASKX ;
+1 KILL DFL,DIC,DISYS,DITC,DSUB,I,X,Y,DIPGM,DMSG,%,DIR,DIT,DFF,DTO,DDSP
+2 QUIT
EOJ ;
+1 KILL DITM,DMSG,DIRUT,L
+2 QUIT
+3 ;8086 NOTE: This option should be used only during non-peak hours...
+4 ;9041 If you merge two entries within a file that is pointed-to...
+5 ;7001 Yes^No
