68 lines
2.9 KiB
Mathematica
68 lines
2.9 KiB
Mathematica
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
|