MCDUPP.m

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 ---MCDUPP   3586     printed  Feb 18, 2025@23:41:23                                                                                                                                                                                                      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