MCDUPP ;WASH/DCB-Post process for the Duplicatation ;Nov 3, 1993
;;2.3;Medicine;;09/13/1996
START ;
N DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
I '$D(^TMP($J,"DUP")) W !,"You must first D ^MCDUPE" Q
W @IOF,!,"This process will repoint your files and "
W !,"remove the duplicates from the static table."
S DIR(0)="Y",DIR("A")="Do you want to continue",DIR("B")="NO" D ^DIR
Q:((Y=0)!$D(DTOUT)!$D(DUOUT)!$D(DIRUT)!$D(DIROUT))
D REP
Q
REP ;do the repointing of the files
N TEMP,REC,LOC,TMP S FILE="",TMP(0)="Re-Indexing global"
F S FILE=$O(^TMP($J,"DUP","F",FILE)) Q:FILE="" D ;go through the file list
.I ^TMP($J,"DUP","F",FILE)=1 D REPOINT(FILE,.TMP),DELETE(FILE) ;if the statics files has duplicates do the repointing
Q
REPOINT(FILE,TMP) ;Repoints the file
N TEMP,LOOP,VAL,LOC,CO,DIE,DA,DR,MCSUB,MCDR,MCDIE,MCDA,TYPE,MCVAL
Q:'$D(^TMP($J,"DUP","J",FILE))
W !,"----------------------------------------------------------"
W !,"Repointing File pointing to ",FILE S VAL="",CO=","
F S VAL=$O(^TMP($J,"DUP","J",FILE,VAL)) Q:VAL="" D
.S TEMP=^TMP($J,"DUP","J",FILE,VAL,1)
.F LOOP="OLD","NEW" D
..S MCVAL=+^TMP($J,"DUP","J",FILE,VAL,LOOP)
..S TYPE=$P(TEMP,U,1),LOC="REP"_TYPE_"(TEMP,MCVAL,CO,LOOP)"
..D @LOC
Q
REPM(TEMP,MCVAL,CO,LOOP) ;Repoint in main file
N DA,DR,DIE,SL0
S SL0=$P(TEMP,U,2)
S DIE=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")
S DA=$P(TEMP,U,3),DR=$P(TEMP,U,4)_"////"_MCVAL
I LOOP="NEW" D
.W !,"----------------------------------------------------------"
.W !," Updating: File: ",SL0,?30," record # ",DA
.W !," With: ",MCVAL
D ^DIE
Q
REPS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-file
N DA,DR,DIE,SL1,SL0
S DIE=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")_$P(TEMP,U,3)_CO_$P(TEMP,U,5)_CO
S DA(1)=$P(TEMP,U,3),DA=$P(TEMP,U,7)
S DR=$P(TEMP,U,8)_"////"_MCVAL
S LOOK1=$$GET1^DID($P(TEMP,U,2),"","","GLOBAL NAME")_$P(TEMP,U,3)_CO_$P(TEMP,U,5)_CO_"0)"
S SL0=+$P(TEMP,U,2)
S SL1=+$P(TEMP,U,6)
I LOOP="NEW" D
.W !,"----------------------------------------------------------"
.W !," Updating: File: ",SL0,?30," record # ",DA(1)
.W !," Subfile: ",SL1,?30," subrecord # ",DA
.W !," With: ",MCVAL
D ^DIE
Q
REPSS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-sub-file
N DA,DR,DIE,SL1,SL2,SL0
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
S SL1=+$P(TEMP,U,10)
S SL2=$P(TEMP,U,6)
S SL0=+$P(TEMP,U,2)
S DR=$P(TEMP,U,12)_"////"_MCVAL
S DA=$P(TEMP,U,11)
S DA(1)=$P(TEMP,U,7),DA(2)=$P(TEMP,U,3)
I LOOP="NEW" D
.W !,"----------------------------------------------------------"
.W !," Updating: File: ",SL0,?30," record # ",DA(2)
.W !," Subfile: ",SL1,?30," subrecord # ",DA(1)
.W !," Sub-Subfile: ",SL2,?30," sub-subrecord # ",DA
.W !," With: ",MCVAL
D ^DIE
Q
DELETE(FILE) ;Delete the Duplicates
N VAL,NEWREC,OLDREC,DIK,DA
Q:'$D(^TMP($J,"DUP","RT",FILE))
W !,"----------------------------------------------------------"
W !," Deleting the static entries in "_FILE
S OLDREC=0 F S OLDREC=$O(^TMP($J,"DUP","RT",FILE,OLDREC)) Q:OLDREC="" D
.S NEWREC=+^TMP($J,"DUP","RT",FILE,OLDREC)
.I OLDREC'=NEWREC D
..W !,?4,"Entry # ",OLDREC
..S DIK=$$GET1^DID(FILE,"","","GLOBAL NAME")
..S %X=DIK_OLDREC_",",%Y="^TMP($J,""DUP"",""STAT"",FILE,"
..D %XY^%RCR ;Copy the static record to the ^TMP($J,"DUP","STAT")
..S DA=OLDREC D ^DIK ;Delete the static entries
W !
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HMCDUPP 3586 printed Dec 13, 2024@02:14:56 Page 2
MCDUPP ;WASH/DCB-Post process for the Duplicatation ;Nov 3, 1993
+1 ;;2.3;Medicine;;09/13/1996
START ;
+1 NEW DIR,Y,DTOUT,DUOUT,DIRUT,DIROUT
+2 IF '$DATA(^TMP($JOB,"DUP"))
WRITE !,"You must first D ^MCDUPE"
QUIT
+3 WRITE @IOF,!,"This process will repoint your files and "
+4 WRITE !,"remove the duplicates from the static table."
+5 SET DIR(0)="Y"
SET DIR("A")="Do you want to continue"
SET DIR("B")="NO"
DO ^DIR
+6 if ((Y=0)!$DATA(DTOUT)!$DATA(DUOUT)!$DATA(DIRUT)!$DATA(DIROUT))
QUIT
+7 DO REP
+8 QUIT
REP ;do the repointing of the files
+1 NEW TEMP,REC,LOC,TMP
SET FILE=""
SET TMP(0)="Re-Indexing global"
+2 ;go through the file list
FOR
SET FILE=$ORDER(^TMP($JOB,"DUP","F",FILE))
if FILE=""
QUIT
Begin DoDot:1
+3 ;if the statics files has duplicates do the repointing
IF ^TMP($JOB,"DUP","F",FILE)=1
DO REPOINT(FILE,.TMP)
DO DELETE(FILE)
End DoDot:1
+4 QUIT
REPOINT(FILE,TMP) ;Repoints the file
+1 NEW TEMP,LOOP,VAL,LOC,CO,DIE,DA,DR,MCSUB,MCDR,MCDIE,MCDA,TYPE,MCVAL
+2 if '$DATA(^TMP($JOB,"DUP","J",FILE))
QUIT
+3 WRITE !,"----------------------------------------------------------"
+4 WRITE !,"Repointing File pointing to ",FILE
SET VAL=""
SET CO=","
+5 FOR
SET VAL=$ORDER(^TMP($JOB,"DUP","J",FILE,VAL))
if VAL=""
QUIT
Begin DoDot:1
+6 SET TEMP=^TMP($JOB,"DUP","J",FILE,VAL,1)
+7 FOR LOOP="OLD","NEW"
Begin DoDot:2
+8 SET MCVAL=+^TMP($JOB,"DUP","J",FILE,VAL,LOOP)
+9 SET TYPE=$PIECE(TEMP,U,1)
SET LOC="REP"_TYPE_"(TEMP,MCVAL,CO,LOOP)"
+10 DO @LOC
End DoDot:2
End DoDot:1
+11 QUIT
REPM(TEMP,MCVAL,CO,LOOP) ;Repoint in main file
+1 NEW DA,DR,DIE,SL0
+2 SET SL0=$PIECE(TEMP,U,2)
+3 SET DIE=$$GET1^DID($PIECE(TEMP,U,2),"","","GLOBAL NAME")
+4 SET DA=$PIECE(TEMP,U,3)
SET DR=$PIECE(TEMP,U,4)_"////"_MCVAL
+5 IF LOOP="NEW"
Begin DoDot:1
+6 WRITE !,"----------------------------------------------------------"
+7 WRITE !," Updating: File: ",SL0,?30," record # ",DA
+8 WRITE !," With: ",MCVAL
End DoDot:1
+9 DO ^DIE
+10 QUIT
REPS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-file
+1 NEW DA,DR,DIE,SL1,SL0
+2 SET DIE=$$GET1^DID($PIECE(TEMP,U,2),"","","GLOBAL NAME")_$PIECE(TEMP,U,3)_CO_$PIECE(TEMP,U,5)_CO
+3 SET DA(1)=$PIECE(TEMP,U,3)
SET DA=$PIECE(TEMP,U,7)
+4 SET DR=$PIECE(TEMP,U,8)_"////"_MCVAL
+5 SET LOOK1=$$GET1^DID($PIECE(TEMP,U,2),"","","GLOBAL NAME")_$PIECE(TEMP,U,3)_CO_$PIECE(TEMP,U,5)_CO_"0)"
+6 SET SL0=+$PIECE(TEMP,U,2)
+7 SET SL1=+$PIECE(TEMP,U,6)
+8 IF LOOP="NEW"
Begin DoDot:1
+9 WRITE !,"----------------------------------------------------------"
+10 WRITE !," Updating: File: ",SL0,?30," record # ",DA(1)
+11 WRITE !," Subfile: ",SL1,?30," subrecord # ",DA
+12 WRITE !," With: ",MCVAL
End DoDot:1
+13 DO ^DIE
+14 QUIT
REPSS(TEMP,MCVAL,CO,LOOP) ;Repoint in a sub-sub-file
+1 NEW DA,DR,DIE,SL1,SL2,SL0
+2 SET DIE=$$GET1^DID($PIECE(TEMP,U,2),"","","GLOBAL NAME")_$PIECE(TEMP,U,3)_CO_$PIECE(TEMP,U,5)_CO_$PIECE(TEMP,U,7)_CO_$PIECE(TEMP,U,9)_CO
+3 SET SL1=+$PIECE(TEMP,U,10)
+4 SET SL2=$PIECE(TEMP,U,6)
+5 SET SL0=+$PIECE(TEMP,U,2)
+6 SET DR=$PIECE(TEMP,U,12)_"////"_MCVAL
+7 SET DA=$PIECE(TEMP,U,11)
+8 SET DA(1)=$PIECE(TEMP,U,7)
SET DA(2)=$PIECE(TEMP,U,3)
+9 IF LOOP="NEW"
Begin DoDot:1
+10 WRITE !,"----------------------------------------------------------"
+11 WRITE !," Updating: File: ",SL0,?30," record # ",DA(2)
+12 WRITE !," Subfile: ",SL1,?30," subrecord # ",DA(1)
+13 WRITE !," Sub-Subfile: ",SL2,?30," sub-subrecord # ",DA
+14 WRITE !," With: ",MCVAL
End DoDot:1
+15 DO ^DIE
+16 QUIT
DELETE(FILE) ;Delete the Duplicates
+1 NEW VAL,NEWREC,OLDREC,DIK,DA
+2 if '$DATA(^TMP($JOB,"DUP","RT",FILE))
QUIT
+3 WRITE !,"----------------------------------------------------------"
+4 WRITE !," Deleting the static entries in "_FILE
+5 SET OLDREC=0
FOR
SET OLDREC=$ORDER(^TMP($JOB,"DUP","RT",FILE,OLDREC))
if OLDREC=""
QUIT
Begin DoDot:1
+6 SET NEWREC=+^TMP($JOB,"DUP","RT",FILE,OLDREC)
+7 IF OLDREC'=NEWREC
Begin DoDot:2
+8 WRITE !,?4,"Entry # ",OLDREC
+9 SET DIK=$$GET1^DID(FILE,"","","GLOBAL NAME")
+10 SET %X=DIK_OLDREC_","
SET %Y="^TMP($J,""DUP"",""STAT"",FILE,"
+11 ;Copy the static record to the ^TMP($J,"DUP","STAT")
DO %XY^%RCR
+12 ;Delete the static entries
SET DA=OLDREC
DO ^DIK
End DoDot:2
End DoDot:1
+13 WRITE !
+14 QUIT
