XDRDADD ;SF-IRMFO/IHS/OHPRD/JCM - ADDS RECORDS TO DUPLICATE RECORD FILE ;2/20/97  10:41
 ;;7.3;TOOLKIT;**23**;Apr 25, 1995
 ;;
START ;
 D INIT ; Sets up the duplicate percentile score and FR and TO DFN's
 I '$D(XDRDPDA) D ADD I 1 ; Adds entrys during background search
 E  D EDIT
END D EOJ ; Cleans up variables
 Q  ;End of routine
 ;
INIT ;
 S XDRDADD("DUPSCORE%")=XDRD("DUPSCORE")/XDRDSCOR("MAX")
 S XDRDADD("DUPSCORE%")=$J(XDRDADD("DUPSCORE%"),1,2)
 S XDRDADD("DUPSCORE%")=$S(XDRDADD("DUPSCORE%")<0:0,XDRDADD("DUPSCORE%")<1:$E(XDRDADD("DUPSCORE%"),3,4),1:100)
 S XDRDADD("FR")=$S(XDRCD<XDRCD2:XDRCD,1:XDRCD2)
 S XDRDADD("TO")=$S(XDRDADD("FR")=XDRCD:XDRCD2,1:XDRCD)
 I $D(XDRDSCOR("VDT")) S XDRDADD("STATUS")=$S(XDRD("DUPSCORE")'<XDRDSCOR("VDT"):"V",1:"P")
 E  S XDRDADD("STATUS")="P"
 Q
 ;
ADD ;
 ;ADD TO DUPLICATE RECORD FILE
 S DIC="^VA(15,",DIC(0)="L",X=XDRDADD("FR")_";"_$P(XDRGL,U,2),DLAYGO=15
 S XDRDADDX=XDRDADD("TO")_";"_$P(XDRGL,U,2)
 S DIC("DR")=".02////^S X=XDRDADDX"_";.03////"_XDRDADD("STATUS")
 S:XDRDADD("STATUS")="V" DIC("DR")=DIC("DR")_";.04////2"
 S DIC("DR")=DIC("DR")_";.06////"_DT
 S DIC("DR")=DIC("DR")_";.15////"_XDRDSCOR("MAX")_";.17////"_XDRDSCOR("PDT%")_";.18////"_XDRD("DUPSCORE")_";.19////"_XDRDADD("DUPSCORE%")
 S:$D(XDRDSCOR("VDT%")) DIC("DR")=DIC("DR")_";.16////"_XDRDSCOR("VDT%")
 D
 . N I,X1,X2,X3
 . S X1=X_U_XDRDADDX,X2=XDRDADDX_U_X
 . F I=0:0 S I=$O(^VA(15,"B",X,I)) Q:I'>0  S X3=$P($G(^VA(15,I,0)),U,1,2) I X3=X1!(X3=X2) K X Q
 S Y=-1 I $D(X) D FILE^DICN
 K DIC,DR,X,DLAYGO
 Q:Y'>0  S DIE="^VA(15,",(XDRDPDA,DA)=+Y
 F XDRDORD=0:0 S XDRDORD=$O(XDRDTEST(XDRDORD)) Q:'XDRDORD  S DR="2101///"_$P(XDRDTEST(XDRDORD),U),DR(2,15.02101)=".02////"_XDRDUP("TEST SCORE",XDRDORD) D ^DIE K DR
 ;I XDRDADD("STATUS")="V" D MERGE ; MODIFIED 1/12/96 JLI TO PREVENT AUTO MERGE
 D
 . N DA,DIE,DR
 . S DA=XDRFL,DIE="^VA(15.1,"
 . S DR=".12///"_($P(^VA(15.1,XDRFL,0),U,12)+1)
 . D ^DIE
ADDX K DIE,DR,DA,XDRDORD,XDRDADDX,XDRDPDA
 Q
MERGE Q
 S XDRMPAIR=XDRDADD("FR")_"^"_XDRDADD("TO"),XDRM("AUTO")=""
 S XDRMPDA=XDRDPDA
 D EN^XDRMAIN
MERGEX K XDRM,XDRMPAIR
 Q
EDIT ;
 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
 S DIE="^VA(15,",DA=XDRDPDA
 S DR=".15////"_XDRDSCOR("MAX")_";.17////"_XDRDSCOR("PDT%")_";.18////"_XDRD("DUPSCORE")_";.19////"_XDRDADD("DUPSCORE%") I $D(XDRDSCOR("VDT%")) S:$D(XDRDSCOR("VDT%")) DR=DR_";.16////"_XDRDSCOR("VDT%")
 D ^DIE K DIE,DA,DR
 F XDRDORD=0:0 S XDRDORD=$O(^VA(15,XDRDPDA,21,0)) Q:'XDRDORD  S DA=XDRDORD,DA(1)=XDRDPDA,DIK="^VA(15,"_DA(1)_",21," S XDRDRTN="^DIK" D IDO K DA,DIK
 K XDRDORD
 F XDRDORD=0:0 S XDRDORD=$O(XDRDTEST(XDRDORD)) Q:'XDRDORD  S DR="2101///"_$P(XDRDTEST(XDRDORD),U),DR(2,15.02101)=".02////"_$P(XDRDTEST(XDRDORD),U,7),DIE="^VA(15,",DA=XDRDPDA,XDRDRTN="^DIE" D IDO K DIE,DA,DR
 K XDRDORD
 Q
IDO NEW D,D0,DB,DC,DE,DG,DH,DI,DIC,DICR,DIEL,DIFLD,DIG,DIH,DINAME,DIP,DIU,DIV,DIW,DK,DL,DM,DOV,DP,DQ,DSC,DU,DV,DW,DXS,X,Y
 D @XDRDRTN K XDRDRTN
 Q
EOJ ;
 K XDRDADD,X,Y
 Q