XDRDADJ ;IHS/EDE/OHPRD;ADJUSTS DUPLICATE RECORD FILE UPON MERGE;   [ 08/13/92  09:50 AM ]
 ;;7.3;TOOLKIT;;Apr 25, 1995
START ;
 K XDRDADJ
 S XDRDADJ("DA")=DA
 NEW D,D0,DA,DB,DC,DE,DG,DH,DI,DIC,DICR,DIE,DIEL,DIFLD,DIG,DIH,DIK,DINAME,DIP,DIU,DIV,DIW,DK,DL,DM,DOV,DP,DQ,DR,DSC,DU,DV,DW,DXS,X,Y,F
 D INIT
 D ENTRIES
END D EOJ
 Q
 ;
 ;
ENTRIES ; ADJUST ENTRIES
 F XDRDADJY=0:0 S XDRDADJY=$O(^VA(15,"B",XDRDADJ("FRC"),XDRDADJY)) Q:XDRDADJY'=+XDRDADJY  I XDRDADJY'=XDRDADJ("DA"),$P(^VA(15,XDRDADJY,0),U,8)="" S X=$P(^(0),U,1,3) D ENTRY
 Q
 ;
ENTRY ; ADJUST ONE ENTRY
 S DA=XDRDADJY
 S XDRDADJ("PC")=$S($P(X,U,1)=XDRDADJ("FRC"):1,1:2)
 S %=+$P(^VA(15,DA,0),U,XDRDADJ("PC")#2+1)_U_XDRDADJ("TO") S:+%>$P(%,U,2) %=$P(%,U,2)_U_$P(%,U,1)
 S Y=0 F X="ANOT","APOT","AVDUP" S Y=$D(^VA(15,X,XDRDADJ("FL"),%)) Q:Y
 I Y D DIK Q
 D KILL
 S $P(^VA(15,DA,0),U,XDRDADJ("PC"))=XDRDADJ("TOC")
 D SET
 I $P(^VA(15,DA,0),U,2)=$P(^(0),U) D DIK Q
 S X="XDRDUP" X ^%ZOSF("TEST") I $T NEW XDRFL,XDRQFLG S XDRDPDA=XDRDADJY D EN^XDRDUP K XDRD,XDRDPDA ; Recompute duplicate score
 Q
 ;
DIK ; CALL ^DIK TO DELETE ENTRY
 ;   Delete entry because another entry has same pair.
 S DIK="^VA(15,"
 D ^DIK K DIK
 Q
 ;
KILL ; DO KILL SIDE OF XREFS
 S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
 S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
 D KILL2
 S XDRDADJ("FLD")=.03
 S X=$P(^VA(15,DA,0),U,3)
 D KILL2
 Q
 ;
KILL2 ;
 F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y  X XDRDXREF(XDRDADJ("FLD"),Y,"K")
 Q
 ;
SET ; DO SET SIDE OF XREFS
 S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
 S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
 D SET2
 S XDRDADJ("FLD")=.03
 S X=$P(^VA(15,DA,0),U,3)
 D SET2
 Q
 ;
SET2 ;
 F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y  X XDRDXREF(XDRDADJ("FLD"),Y,"S")
 Q
 ;
INIT ;
 S F=15 F X=.01,.02,.03 D XREFS ; Get xrefs less triggers
 S X=$P(^VA(15,XDRDADJ("DA"),0),U,1,4),%=$P(X,U,4)
 S XDRDADJ("FR")=+$P(X,U,%)
 S XDRDADJ("FPC")=%
 S XDRDADJ("TO")=+$P(X,U,%#2+1)
 S XDRDADJ("TPC")=%#2+1
 S XDRDADJ("FL")=$P($P(X,U,1),";",2)
 S XDRDADJ("FRC")=XDRDADJ("FR")_";"_XDRDADJ("FL")
 S XDRDADJ("TOC")=XDRDADJ("TO")_";"_XDRDADJ("FL")
 Q
 ;
XREFS ; GET XREFS LESS TRIGGERS
 F Y=0:0 S Y=$O(^DD(F,X,1,Y)) Q:Y'=+Y  S:^(Y,0)'["TRIGGER" XDRDXREF(X,Y)=^(0),XDRDXREF(X,Y,"S")=^(1),XDRDXREF(X,Y,"K")=^(2)
 Q
 ;
EOJ ;
 K XDRDADJ,XDRDADJY,XDRDXREF
 Q