source: FOIAVistA/trunk/r/MEDICINE-MC/MCDUPP.m@ 1806

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

initial load of FOIAVistA 6/30/08 version

File size: 3.4 KB
Line 
1MCDUPP ;WASH/DCB-Post process for the Duplicatation ;Nov 3, 1993
2 ;;2.3;Medicine;;09/13/1996
3START ;
4 N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
5 I '$D(^TMP($J,"DUP")) W !,"You must first D ^MCDUPE" Q
6 W @IOF,!,"This process will repoint your files and "
7 W !,"remove the duplicates from the static table."
8 S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR
9 Q:((Y=0)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT))
10 D REP
11 Q
12REP ;do the repointing of the files
13 N TEMP,REC,LOC,TMP S FILE="",TMP(0)="Re-Indexing global"
14 F S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE="" D ;go through the file list
15 .I ^TMP($J,"DUP","F",FILE)=1 D REPOINT(FILE,.TMP),DELETE(FILE) ;if the statics files has duplicates do the repointing
16 Q
17REPOINT(FILE,TMP) ;Repoints the file
18 N TEMP,LOOP,VAL,LOC,CO,DIE,DA,DR,MCSUB,MCDR,MCDIE,MCDA,TYPE,MCVAL
19 Q:'$D(^TMP($J,"DUP","J",FILE))
20 W !,"----------------------------------------------------------"
21 W !,"Repointing File pointing to ",FILE S VAL="",CO=","
22 F S VAL=$O(^TMP($J,"DUP","J",FILE,VAL)) Q:VAL="" D
23 .S TEMP=^TMP($J,"DUP","J",FILE,VAL,1)
24 .F LOOP="OLD","NEW" D
25 ..S MCVAL=+^TMP($J,"DUP","J",FILE,VAL,LOOP)
26 ..S TYPE=$P(TEMP,U,1),LOC="REP"_TYPE_"(TEMP,MCVAL,CO,LOOP)"
27 ..D @LOC
28 Q
29REPM(TEMP,MCVAL,CO,LOOP) ;Repoint in main file
30 N DA,DR,DIE,SL0
31 S SL0=$P(TEMP,U,2)
32 S DIE=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")
33 S DA=$P(TEMP,U,3),DR=$P(TEMP,U,4)_"////"_MCVAL
34 I LOOP="NEW" D
35 .W !,"----------------------------------------------------------"
36 .W !," Updating: File: ",SL0,?30," record # ",DA
37 .W !," With: ",MCVAL
38 D ^DIE
39 Q
40REPS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-file
41 N DA,DR,DIE,SL1,SL0
42 S DIE=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")_$P(TEMP,U,3)_CO_$P(TEMP,U,5)_CO
43 S DA(1)=$P(TEMP,U,3),DA=$P(TEMP,U,7)
44 S DR=$P(TEMP,U,8)_"////"_MCVAL
45 S LOOK1=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")_$P(TEMP,U,3)_CO_$P(TEMP,U,5)_CO_"0)"
46 S SL0=+$P(TEMP,U,2)
47 S SL1=+$P(TEMP,U,6)
48 I LOOP="NEW" D
49 .W !,"----------------------------------------------------------"
50 .W !," Updating: File: ",SL0,?30," record # ",DA(1)
51 .W !," Subfile: ",SL1,?30," subrecord # ",DA
52 .W !," With: ",MCVAL
53 D ^DIE
54 Q
55REPSS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-sub-file
56 N DA,DR,DIE,SL1,SL2,SL0
57 S DIE=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")_$P(TEMP,U,3)_CO_$P(TEMP,U,5)_CO_$P(TEMP,U,7)_CO_$P(TEMP,U,9)_CO
58 S SL1=+$P(TEMP,U,10)
59 S SL2=$P(TEMP,U,6)
60 S SL0=+$P(TEMP,U,2)
61 S DR=$P(TEMP,U,12)_"////"_MCVAL
62 S DA=$P(TEMP,U,11)
63 S DA(1)=$P(TEMP,U,7),DA(2)=$P(TEMP,U,3)
64 I LOOP="NEW" D
65 .W !,"----------------------------------------------------------"
66 .W !," Updating: File: ",SL0,?30," record # ",DA(2)
67 .W !," Subfile: ",SL1,?30," subrecord # ",DA(1)
68 .W !," Sub-Subfile: ",SL2,?30," sub-subrecord # ",DA
69 .W !," With: ",MCVAL
70 D ^DIE
71 Q
72DELETE(FILE) ;Delete the Duplicates
73 N VAL,NEWREC,OLDREC,DIK,DA
74 Q:'$D(^TMP($J,"DUP","RT",FILE))
75 W !,"----------------------------------------------------------"
76 W !," Deleting the static entries in "_FILE
77 S OLDREC=0 F S OLDREC=$O(^TMP($J,"DUP","RT",FILE,OLDREC)) Q:OLDREC="" D
78 .S NEWREC=+^TMP($J,"DUP","RT",FILE,OLDREC)
79 .I OLDREC'=NEWREC D
80 ..W !,?4,"Entry # ",OLDREC
81 ..S DIK=$$GET1^DID(FILE,"","","GLOBAL NAME")
82 ..S %X=DIK_OLDREC_",",%Y="^TMP($J,""DUP"",""STAT"",FILE,"
83 ..D %XY^%RCR ;Copy the static record to the ^TMP($J,"DUP","STAT")
84 ..S DA=OLDREC D ^DIK ;Delete the static entries
85 W !
86 Q
Note: See TracBrowser for help on using the repository browser.