| [613] | 1 | ESPDUP ;ALBANY/CJM - DELETES DUPLICATE ENTRIES IN MASTER NAME INDEX FILE;8/92
 | 
|---|
 | 2 |  ;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
 | 
|---|
 | 3 |  ;
 | 
|---|
 | 4 | EN ;Allows duplicate names to be deleted from the Master Name Index file.
 | 
|---|
 | 5 |  ;The user is required to select the name which is the 'good' one.
 | 
|---|
 | 6 |  ;
 | 
|---|
 | 7 |  N NAME
 | 
|---|
 | 8 |  S (NAME("DELETE"),NAME("KEEP"))=""
 | 
|---|
 | 9 |  W !!,"Which name do you want to delete from the Master Name Index?"
 | 
|---|
 | 10 |  S NAME("DELETE")=$$SELECT
 | 
|---|
 | 11 |  Q:'NAME("DELETE")
 | 
|---|
 | 12 |  ;
 | 
|---|
 | 13 |  W !!,"** PLEASE NOTE **"
 | 
|---|
 | 14 |  W !,"Entries in the Master Name Index file are referenced from many other files."
 | 
|---|
 | 15 |  W !,"Before you are allowed to delete a duplicate entry you must first indicate"
 | 
|---|
 | 16 |  W !,"the correct entry to keep so that all references in all files can be changed"
 | 
|---|
 | 17 |  W !,"to the correct entry."
 | 
|---|
 | 18 |  W !!,"Which entry do you want to keep?",!
 | 
|---|
 | 19 |  ;
 | 
|---|
 | 20 |  F  D  Q:(NAME("DELETE")'=NAME("KEEP"))
 | 
|---|
 | 21 |  .S NAME("KEEP")=$$SELECT
 | 
|---|
 | 22 |  .I NAME("DELETE")=NAME("KEEP") W !,"You must select a different entry!",!
 | 
|---|
 | 23 |  Q:'NAME("KEEP")
 | 
|---|
 | 24 |  ;
 | 
|---|
 | 25 |  D:$$RUSURE(NAME("DELETE"),NAME("KEEP"))
 | 
|---|
 | 26 |  .;
 | 
|---|
 | 27 |  .;first update all the xrefs, replacing NAME("DELETE") with NAME("KEEP")
 | 
|---|
 | 28 |  .D REPLACE(NAME("DELETE"),NAME("KEEP"))
 | 
|---|
 | 29 |  .;
 | 
|---|
 | 30 |  .;next delete the duplicate entry
 | 
|---|
 | 31 |  .D DELETE(NAME("DELETE"))
 | 
|---|
 | 32 |  .W !!,"DONE",!!
 | 
|---|
 | 33 |  Q
 | 
|---|
 | 34 |  ;
 | 
|---|
 | 35 | SELECT() ;
 | 
|---|
 | 36 |  ;asks user to select from file 910
 | 
|---|
 | 37 |  ;returns ptr to file 910, the Master Name Index
 | 
|---|
 | 38 |  ;
 | 
|---|
 | 39 |  N Y,DINUM,DIC,X,DTIME,DLAYGO
 | 
|---|
 | 40 |  S DIC=910,DIC(0)="AEFMQ"
 | 
|---|
 | 41 |  S DIC("A")="Select a name: "
 | 
|---|
 | 42 |  D ^DIC
 | 
|---|
 | 43 |  I (Y=-1)!$D(DTOUT)!$D(DUOUT) Q 0
 | 
|---|
 | 44 |  Q +Y
 | 
|---|
 | 45 |  ;
 | 
|---|
 | 46 | REPLACE(OLD,NEW) ;
 | 
|---|
 | 47 |  ;replaces all pointers to file 910 = OLD with NEW
 | 
|---|
 | 48 |  ;
 | 
|---|
 | 49 |  N REF,COUNT,REC,SUBREC
 | 
|---|
 | 50 |  S COUNT=1
 | 
|---|
 | 51 |  F  S REF=$P($T(REFS+COUNT),";;",2) Q:(REF="")  D
 | 
|---|
 | 52 |  .S COUNT=COUNT+1
 | 
|---|
 | 53 |  .S REF("FILE")=$P(REF,"^"),REF("XREF")=$P(REF,"^",2),REF("SUB")=$P(REF,"^",3),REF("FIELD")=$P(REF,"^",4)
 | 
|---|
 | 54 |  .Q:REF("FILE")=""
 | 
|---|
 | 55 |  .Q:REF("XREF")=""
 | 
|---|
 | 56 |  .Q:REF("FIELD")=""
 | 
|---|
 | 57 |  .;
 | 
|---|
 | 58 |  .S REC=0 F  S REC=$O(^ESP(REF("FILE"),REF("XREF"),OLD,REC)) Q:'REC  D
 | 
|---|
 | 59 |  ..I REF("SUB")="" D
 | 
|---|
 | 60 |  ...D EDIT(REF("FILE"),REC,REF("FIELD"),NEW)
 | 
|---|
 | 61 |  ..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)
 | 
|---|
 | 62 |  Q
 | 
|---|
 | 63 |  ;
 | 
|---|
 | 64 | DELETE(OLD) ;
 | 
|---|
 | 65 |  N DIK,DA
 | 
|---|
 | 66 |  S DIK="^ESP(910,",DA=OLD
 | 
|---|
 | 67 |  D ^DIK
 | 
|---|
 | 68 |  W !,"DELETED",!
 | 
|---|
 | 69 |  Q
 | 
|---|
 | 70 |  ;
 | 
|---|
 | 71 | RUSURE(OLD,NEW) ;
 | 
|---|
 | 72 |  ;
 | 
|---|
 | 73 |  N DIR,DA,X,Y
 | 
|---|
 | 74 |  S DIR(0)="Y"
 | 
|---|
 | 75 |  S DIR("B")="NO"
 | 
|---|
 | 76 |  S DIR("A")="Replace "_$P($G(^ESP(910,OLD,0)),"^")_" with "_$P($G(^ESP(910,NEW,0)),"^")_" and then delete"
 | 
|---|
 | 77 |  W !
 | 
|---|
 | 78 |  D ^DIR
 | 
|---|
 | 79 |  Q Y
 | 
|---|
 | 80 |  ;
 | 
|---|
 | 81 | EDIT(FILE,REC,FIELD,VALUE,SUB,SUBREC) ;
 | 
|---|
 | 82 |  N DIE,DA,DR
 | 
|---|
 | 83 |  S DIE="^ESP("_FILE_","
 | 
|---|
 | 84 |  S DR=FIELD_"////"_VALUE
 | 
|---|
 | 85 |  I $G(SUB)="" D
 | 
|---|
 | 86 |  .S DA=REC
 | 
|---|
 | 87 |  .D ^DIE
 | 
|---|
 | 88 |  E  D
 | 
|---|
 | 89 |  .Q:'SUBREC
 | 
|---|
 | 90 |  .S DIE=DIE_REC_","_SUB_","
 | 
|---|
 | 91 |  .S DA(1)=REC
 | 
|---|
 | 92 |  .S DA=SUBREC
 | 
|---|
 | 93 |  .D ^DIE
 | 
|---|
 | 94 |  Q
 | 
|---|
 | 95 |  ;
 | 
|---|
 | 96 |  ;
 | 
|---|
 | 97 | REFS ;;<file #>;<xref>;<subscript if in multiple>;<field #>
 | 
|---|
 | 98 |  ;;910.2^D^^.03
 | 
|---|
 | 99 |  ;;910.2^I^^4.05
 | 
|---|
 | 100 |  ;;910.2^J^^5.01
 | 
|---|
 | 101 |  ;;910.2^V^^6.01
 | 
|---|
 | 102 |  ;;910.2^BI^^6.02
 | 
|---|
 | 103 |  ;;910.2^W^^6.03
 | 
|---|
 | 104 |  ;;910.2^P^^6.04
 | 
|---|
 | 105 |  ;;910.2^G^^6.05
 | 
|---|
 | 106 |  ;;910.8^C^1^.04
 | 
|---|
 | 107 |  ;;910.8^D^5^.03
 | 
|---|
 | 108 |  ;;912^D^20^.02
 | 
|---|
 | 109 |  ;;912^E^30^.02
 | 
|---|
 | 110 |  ;;912^G^40^.02
 | 
|---|
 | 111 |  ;;912^I^50^.02
 | 
|---|
 | 112 |  ;;912^J^80^.11
 | 
|---|
 | 113 |  ;;913^B^^.01
 | 
|---|
 | 114 |  ;;914^E^^.09
 | 
|---|
 | 115 |  ;;
 | 
|---|