ESPDUP ;ALBANY/CJM - DELETES DUPLICATE ENTRIES IN MASTER NAME INDEX FILE;8/92
;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
;
EN ;Allows duplicate names to be deleted from the Master Name Index file.
;The user is required to select the name which is the 'good' one.
;
N NAME
S (NAME("DELETE"),NAME("KEEP"))=""
W !!,"Which name do you want to delete from the Master Name Index?"
S NAME("DELETE")=$$SELECT
Q:'NAME("DELETE")
;
W !!,"** PLEASE NOTE **"
W !,"Entries in the Master Name Index file are referenced from many other files."
W !,"Before you are allowed to delete a duplicate entry you must first indicate"
W !,"the correct entry to keep so that all references in all files can be changed"
W !,"to the correct entry."
W !!,"Which entry do you want to keep?",!
;
F D Q:(NAME("DELETE")'=NAME("KEEP"))
.S NAME("KEEP")=$$SELECT
.I NAME("DELETE")=NAME("KEEP") W !,"You must select a different entry!",!
Q:'NAME("KEEP")
;
D:$$RUSURE(NAME("DELETE"),NAME("KEEP"))
.;
.;first update all the xrefs, replacing NAME("DELETE") with NAME("KEEP")
.D REPLACE(NAME("DELETE"),NAME("KEEP"))
.;
.;next delete the duplicate entry
.D DELETE(NAME("DELETE"))
.W !!,"DONE",!!
Q
;
SELECT() ;
;asks user to select from file 910
;returns ptr to file 910, the Master Name Index
;
N Y,DINUM,DIC,X,DTIME,DLAYGO
S DIC=910,DIC(0)="AEFMQ"
S DIC("A")="Select a name: "
D ^DIC
I (Y=-1)!$D(DTOUT)!$D(DUOUT) Q 0
Q +Y
;
REPLACE(OLD,NEW) ;
;replaces all pointers to file 910 = OLD with NEW
;
N REF,COUNT,REC,SUBREC
S COUNT=1
F S REF=$P($T(REFS+COUNT),";;",2) Q:(REF="") D
.S COUNT=COUNT+1
.S REF("FILE")=$P(REF,"^"),REF("XREF")=$P(REF,"^",2),REF("SUB")=$P(REF,"^",3),REF("FIELD")=$P(REF,"^",4)
.Q:REF("FILE")=""
.Q:REF("XREF")=""
.Q:REF("FIELD")=""
.;
.S REC=0 F S REC=$O(^ESP(REF("FILE"),REF("XREF"),OLD,REC)) Q:'REC D
..I REF("SUB")="" D
...D EDIT(REF("FILE"),REC,REF("FIELD"),NEW)
..E S SUBREC=0 F S SUBREC=$O(^ESP(REF("FILE"),REF("XREF"),OLD,REC,SUBREC)) Q:'SUBREC D EDIT(REF("FILE"),REC,REF("FIELD"),NEW,REF("SUB"),SUBREC)
Q
;
DELETE(OLD) ;
N DIK,DA
S DIK="^ESP(910,",DA=OLD
D ^DIK
W !,"DELETED",!
Q
;
RUSURE(OLD,NEW) ;
;
N DIR,DA,X,Y
S DIR(0)="Y"
S DIR("B")="NO"
S DIR("A")="Replace "_$P($G(^ESP(910,OLD,0)),"^")_" with "_$P($G(^ESP(910,NEW,0)),"^")_" and then delete"
W !
D ^DIR
Q Y
;
EDIT(FILE,REC,FIELD,VALUE,SUB,SUBREC) ;
N DIE,DA,DR
S DIE="^ESP("_FILE_","
S DR=FIELD_"////"_VALUE
I $G(SUB)="" D
.S DA=REC
.D ^DIE
E D
.Q:'SUBREC
.S DIE=DIE_REC_","_SUB_","
.S DA(1)=REC
.S DA=SUBREC
.D ^DIE
Q
;
;
REFS ;;<file #><xref><subscript if in multiple><field #>
;;910.2^D^^.03
;;910.2^I^^4.05
;;910.2^J^^5.01
;;910.2^V^^6.01
;;910.2^BI^^6.02
;;910.2^W^^6.03
;;910.2^P^^6.04
;;910.2^G^^6.05
;;910.8^C^1^.04
;;910.8^D^5^.03
;;912^D^20^.02
;;912^E^30^.02
;;912^G^40^.02
;;912^I^50^.02
;;912^J^80^.11
;;913^B^^.01
;;914^E^^.09
;;
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HESPDUP 3025 printed Dec 13, 2024@02:29:38 Page 2
ESPDUP ;ALBANY/CJM - DELETES DUPLICATE ENTRIES IN MASTER NAME INDEX FILE;8/92
+1 ;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
+2 ;
EN ;Allows duplicate names to be deleted from the Master Name Index file.
+1 ;The user is required to select the name which is the 'good' one.
+2 ;
+3 NEW NAME
+4 SET (NAME("DELETE"),NAME("KEEP"))=""
+5 WRITE !!,"Which name do you want to delete from the Master Name Index?"
+6 SET NAME("DELETE")=$$SELECT
+7 if 'NAME("DELETE")
QUIT
+8 ;
+9 WRITE !!,"** PLEASE NOTE **"
+10 WRITE !,"Entries in the Master Name Index file are referenced from many other files."
+11 WRITE !,"Before you are allowed to delete a duplicate entry you must first indicate"
+12 WRITE !,"the correct entry to keep so that all references in all files can be changed"
+13 WRITE !,"to the correct entry."
+14 WRITE !!,"Which entry do you want to keep?",!
+15 ;
+16 FOR
Begin DoDot:1
+17 SET NAME("KEEP")=$$SELECT
+18 IF NAME("DELETE")=NAME("KEEP")
WRITE !,"You must select a different entry!",!
End DoDot:1
if (NAME("DELETE")'=NAME("KEEP"))
QUIT
+19 if 'NAME("KEEP")
QUIT
+20 ;
+21 if $$RUSURE(NAME("DELETE"),NAME("KEEP"))
Begin DoDot:1
+22 ;
+23 ;first update all the xrefs, replacing NAME("DELETE") with NAME("KEEP")
+24 DO REPLACE(NAME("DELETE"),NAME("KEEP"))
+25 ;
+26 ;next delete the duplicate entry
+27 DO DELETE(NAME("DELETE"))
+28 WRITE !!,"DONE",!!
End DoDot:1
+29 QUIT
+30 ;
SELECT() ;
+1 ;asks user to select from file 910
+2 ;returns ptr to file 910, the Master Name Index
+3 ;
+4 NEW Y,DINUM,DIC,X,DTIME,DLAYGO
+5 SET DIC=910
SET DIC(0)="AEFMQ"
+6 SET DIC("A")="Select a name: "
+7 DO ^DIC
+8 IF (Y=-1)!$DATA(DTOUT)!$DATA(DUOUT)
QUIT 0
+9 QUIT +Y
+10 ;
REPLACE(OLD,NEW) ;
+1 ;replaces all pointers to file 910 = OLD with NEW
+2 ;
+3 NEW REF,COUNT,REC,SUBREC
+4 SET COUNT=1
+5 FOR
SET REF=$PIECE($TEXT(REFS+COUNT),";;",2)
if (REF="")
QUIT
Begin DoDot:1
+6 SET COUNT=COUNT+1
+7 SET REF("FILE")=$PIECE(REF,"^")
SET REF("XREF")=$PIECE(REF,"^",2)
SET REF("SUB")=$PIECE(REF,"^",3)
SET REF("FIELD")=$PIECE(REF,"^",4)
+8 if REF("FILE")=""
QUIT
+9 if REF("XREF")=""
QUIT
+10 if REF("FIELD")=""
QUIT
+11 ;
+12 SET REC=0
FOR
SET REC=$ORDER(^ESP(REF("FILE"),REF("XREF"),OLD,REC))
if 'REC
QUIT
Begin DoDot:2
+13 IF REF("SUB")=""
Begin DoDot:3
+14 DO EDIT(REF("FILE"),REC,REF("FIELD"),NEW)
End DoDot:3
+15 IF '$TEST
SET SUBREC=0
FOR
SET SUBREC=$ORDER(^ESP(REF("FILE"),REF("XREF"),OLD,REC,SUBREC))
if 'SUBREC
QUIT
DO EDIT(REF("FILE"),REC,REF("FIELD"),NEW,REF("SUB"),SUBREC)
End DoDot:2
End DoDot:1
+16 QUIT
+17 ;
DELETE(OLD) ;
+1 NEW DIK,DA
+2 SET DIK="^ESP(910,"
SET DA=OLD
+3 DO ^DIK
+4 WRITE !,"DELETED",!
+5 QUIT
+6 ;
RUSURE(OLD,NEW) ;
+1 ;
+2 NEW DIR,DA,X,Y
+3 SET DIR(0)="Y"
+4 SET DIR("B")="NO"
+5 SET DIR("A")="Replace "_$PIECE($GET(^ESP(910,OLD,0)),"^")_" with "_$PIECE($GET(^ESP(910,NEW,0)),"^")_" and then delete"
+6 WRITE !
+7 DO ^DIR
+8 QUIT Y
+9 ;
EDIT(FILE,REC,FIELD,VALUE,SUB,SUBREC) ;
+1 NEW DIE,DA,DR
+2 SET DIE="^ESP("_FILE_","
+3 SET DR=FIELD_"////"_VALUE
+4 IF $GET(SUB)=""
Begin DoDot:1
+5 SET DA=REC
+6 DO ^DIE
End DoDot:1
+7 IF '$TEST
Begin DoDot:1
+8 if 'SUBREC
QUIT
+9 SET DIE=DIE_REC_","_SUB_","
+10 SET DA(1)=REC
+11 SET DA=SUBREC
+12 DO ^DIE
End DoDot:1
+13 QUIT
+14 ;
+15 ;
REFS ;;<file #><xref><subscript if in multiple><field #>
+1 ;;910.2^D^^.03
+2 ;;910.2^I^^4.05
+3 ;;910.2^J^^5.01
+4 ;;910.2^V^^6.01
+5 ;;910.2^BI^^6.02
+6 ;;910.2^W^^6.03
+7 ;;910.2^P^^6.04
+8 ;;910.2^G^^6.05
+9 ;;910.8^C^1^.04
+10 ;;910.8^D^5^.03
+11 ;;912^D^20^.02
+12 ;;912^E^30^.02
+13 ;;912^G^40^.02
+14 ;;912^I^50^.02
+15 ;;912^J^80^.11
+16 ;;913^B^^.01
+17 ;;914^E^^.09
+18 ;;
