source: WorldVistAEHR/trunk/r/POLICE_AND_SECURITY-ES/ESPDUP.m@ 1325

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
 ;;