| [613] | 1 | XDRDADD ;SF-IRMFO/IHS/OHPRD/JCM - ADDS RECORDS TO DUPLICATE RECORD FILE ;2/20/97 10:41
|
|---|
| 2 | ;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | START ;
|
|---|
| 5 | D INIT ; Sets up the duplicate percentile score and FR and TO DFN's
|
|---|
| 6 | I '$D(XDRDPDA) D ADD I 1 ; Adds entrys during background search
|
|---|
| 7 | E D EDIT
|
|---|
| 8 | END D EOJ ; Cleans up variables
|
|---|
| 9 | Q ;End of routine
|
|---|
| 10 | ;
|
|---|
| 11 | INIT ;
|
|---|
| 12 | S XDRDADD("DUPSCORE%")=XDRD("DUPSCORE")/XDRDSCOR("MAX")
|
|---|
| 13 | S XDRDADD("DUPSCORE%")=$J(XDRDADD("DUPSCORE%"),1,2)
|
|---|
| 14 | S XDRDADD("DUPSCORE%")=$S(XDRDADD("DUPSCORE%")<0:0,XDRDADD("DUPSCORE%")<1:$E(XDRDADD("DUPSCORE%"),3,4),1:100)
|
|---|
| 15 | S XDRDADD("FR")=$S(XDRCD<XDRCD2:XDRCD,1:XDRCD2)
|
|---|
| 16 | S XDRDADD("TO")=$S(XDRDADD("FR")=XDRCD:XDRCD2,1:XDRCD)
|
|---|
| 17 | I $D(XDRDSCOR("VDT")) S XDRDADD("STATUS")=$S(XDRD("DUPSCORE")'<XDRDSCOR("VDT"):"V",1:"P")
|
|---|
| 18 | E S XDRDADD("STATUS")="P"
|
|---|
| 19 | Q
|
|---|
| 20 | ;
|
|---|
| 21 | ADD ;
|
|---|
| 22 | ;ADD TO DUPLICATE RECORD FILE
|
|---|
| 23 | S DIC="^VA(15,",DIC(0)="L",X=XDRDADD("FR")_";"_$P(XDRGL,U,2),DLAYGO=15
|
|---|
| 24 | S XDRDADDX=XDRDADD("TO")_";"_$P(XDRGL,U,2)
|
|---|
| 25 | S DIC("DR")=".02////^S X=XDRDADDX"_";.03////"_XDRDADD("STATUS")
|
|---|
| 26 | S:XDRDADD("STATUS")="V" DIC("DR")=DIC("DR")_";.04////2"
|
|---|
| 27 | S DIC("DR")=DIC("DR")_";.06////"_DT
|
|---|
| 28 | S DIC("DR")=DIC("DR")_";.15////"_XDRDSCOR("MAX")_";.17////"_XDRDSCOR("PDT%")_";.18////"_XDRD("DUPSCORE")_";.19////"_XDRDADD("DUPSCORE%")
|
|---|
| 29 | S:$D(XDRDSCOR("VDT%")) DIC("DR")=DIC("DR")_";.16////"_XDRDSCOR("VDT%")
|
|---|
| 30 | D
|
|---|
| 31 | . N I,X1,X2,X3
|
|---|
| 32 | . S X1=X_U_XDRDADDX,X2=XDRDADDX_U_X
|
|---|
| 33 | . 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
|
|---|
| 34 | S Y=-1 I $D(X) D FILE^DICN
|
|---|
| 35 | K DIC,DR,X,DLAYGO
|
|---|
| 36 | Q:Y'>0 S DIE="^VA(15,",(XDRDPDA,DA)=+Y
|
|---|
| 37 | 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
|
|---|
| 38 | ;I XDRDADD("STATUS")="V" D MERGE ; MODIFIED 1/12/96 JLI TO PREVENT AUTO MERGE
|
|---|
| 39 | D
|
|---|
| 40 | . N DA,DIE,DR
|
|---|
| 41 | . S DA=XDRFL,DIE="^VA(15.1,"
|
|---|
| 42 | . S DR=".12///"_($P(^VA(15.1,XDRFL,0),U,12)+1)
|
|---|
| 43 | . D ^DIE
|
|---|
| 44 | ADDX K DIE,DR,DA,XDRDORD,XDRDADDX,XDRDPDA
|
|---|
| 45 | Q
|
|---|
| 46 | MERGE Q
|
|---|
| 47 | S XDRMPAIR=XDRDADD("FR")_"^"_XDRDADD("TO"),XDRM("AUTO")=""
|
|---|
| 48 | S XDRMPDA=XDRDPDA
|
|---|
| 49 | D EN^XDRMAIN
|
|---|
| 50 | MERGEX K XDRM,XDRMPAIR
|
|---|
| 51 | Q
|
|---|
| 52 | EDIT ;
|
|---|
| 53 | 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
|
|---|
| 54 | S DIE="^VA(15,",DA=XDRDPDA
|
|---|
| 55 | 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%")
|
|---|
| 56 | D ^DIE K DIE,DA,DR
|
|---|
| 57 | 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
|
|---|
| 58 | K XDRDORD
|
|---|
| 59 | 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
|
|---|
| 60 | K XDRDORD
|
|---|
| 61 | Q
|
|---|
| 62 | 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
|
|---|
| 63 | D @XDRDRTN K XDRDRTN
|
|---|
| 64 | Q
|
|---|
| 65 | EOJ ;
|
|---|
| 66 | K XDRDADD,X,Y
|
|---|
| 67 | Q
|
|---|
