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

Last change on this file since 794 was 613, checked in by George Lilly, 15 years ago

initial load of WorldVistAEHR

File size: 2.8 KB
RevLine 
[613]1ESPDUP ;ALBANY/CJM - DELETES DUPLICATE ENTRIES IN MASTER NAME INDEX FILE;8/92
2 ;;1.0;POLICE & SECURITY;**17**;Mar 31, 1994
3 ;
4EN ;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 ;
35SELECT() ;
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 ;
46REPLACE(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 ;
64DELETE(OLD) ;
65 N DIK,DA
66 S DIK="^ESP(910,",DA=OLD
67 D ^DIK
68 W !,"DELETED",!
69 Q
70 ;
71RUSURE(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 ;
81EDIT(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 ;
97REFS ;;<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 ;;
Note: See TracBrowser for help on using the repository browser.