| [613] | 1 | XDRDADJ ;IHS/EDE/OHPRD;ADJUSTS DUPLICATE RECORD FILE UPON MERGE; [ 08/13/92 09:50 AM ]
|
|---|
| 2 | ;;7.3;TOOLKIT;;Apr 25, 1995
|
|---|
| 3 | START ;
|
|---|
| 4 | K XDRDADJ
|
|---|
| 5 | S XDRDADJ("DA")=DA
|
|---|
| 6 | 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
|
|---|
| 7 | D INIT
|
|---|
| 8 | D ENTRIES
|
|---|
| 9 | END D EOJ
|
|---|
| 10 | Q
|
|---|
| 11 | ;
|
|---|
| 12 | ;
|
|---|
| 13 | ENTRIES ; ADJUST ENTRIES
|
|---|
| 14 | 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
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | ENTRY ; ADJUST ONE ENTRY
|
|---|
| 18 | S DA=XDRDADJY
|
|---|
| 19 | S XDRDADJ("PC")=$S($P(X,U,1)=XDRDADJ("FRC"):1,1:2)
|
|---|
| 20 | 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)
|
|---|
| 21 | S Y=0 F X="ANOT","APOT","AVDUP" S Y=$D(^VA(15,X,XDRDADJ("FL"),%)) Q:Y
|
|---|
| 22 | I Y D DIK Q
|
|---|
| 23 | D KILL
|
|---|
| 24 | S $P(^VA(15,DA,0),U,XDRDADJ("PC"))=XDRDADJ("TOC")
|
|---|
| 25 | D SET
|
|---|
| 26 | I $P(^VA(15,DA,0),U,2)=$P(^(0),U) D DIK Q
|
|---|
| 27 | S X="XDRDUP" X ^%ZOSF("TEST") I $T NEW XDRFL,XDRQFLG S XDRDPDA=XDRDADJY D EN^XDRDUP K XDRD,XDRDPDA ; Recompute duplicate score
|
|---|
| 28 | Q
|
|---|
| 29 | ;
|
|---|
| 30 | DIK ; CALL ^DIK TO DELETE ENTRY
|
|---|
| 31 | ; Delete entry because another entry has same pair.
|
|---|
| 32 | S DIK="^VA(15,"
|
|---|
| 33 | D ^DIK K DIK
|
|---|
| 34 | Q
|
|---|
| 35 | ;
|
|---|
| 36 | KILL ; DO KILL SIDE OF XREFS
|
|---|
| 37 | S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
|
|---|
| 38 | S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
|
|---|
| 39 | D KILL2
|
|---|
| 40 | S XDRDADJ("FLD")=.03
|
|---|
| 41 | S X=$P(^VA(15,DA,0),U,3)
|
|---|
| 42 | D KILL2
|
|---|
| 43 | Q
|
|---|
| 44 | ;
|
|---|
| 45 | KILL2 ;
|
|---|
| 46 | F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y X XDRDXREF(XDRDADJ("FLD"),Y,"K")
|
|---|
| 47 | Q
|
|---|
| 48 | ;
|
|---|
| 49 | SET ; DO SET SIDE OF XREFS
|
|---|
| 50 | S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
|
|---|
| 51 | S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
|
|---|
| 52 | D SET2
|
|---|
| 53 | S XDRDADJ("FLD")=.03
|
|---|
| 54 | S X=$P(^VA(15,DA,0),U,3)
|
|---|
| 55 | D SET2
|
|---|
| 56 | Q
|
|---|
| 57 | ;
|
|---|
| 58 | SET2 ;
|
|---|
| 59 | F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y X XDRDXREF(XDRDADJ("FLD"),Y,"S")
|
|---|
| 60 | Q
|
|---|
| 61 | ;
|
|---|
| 62 | INIT ;
|
|---|
| 63 | S F=15 F X=.01,.02,.03 D XREFS ; Get xrefs less triggers
|
|---|
| 64 | S X=$P(^VA(15,XDRDADJ("DA"),0),U,1,4),%=$P(X,U,4)
|
|---|
| 65 | S XDRDADJ("FR")=+$P(X,U,%)
|
|---|
| 66 | S XDRDADJ("FPC")=%
|
|---|
| 67 | S XDRDADJ("TO")=+$P(X,U,%#2+1)
|
|---|
| 68 | S XDRDADJ("TPC")=%#2+1
|
|---|
| 69 | S XDRDADJ("FL")=$P($P(X,U,1),";",2)
|
|---|
| 70 | S XDRDADJ("FRC")=XDRDADJ("FR")_";"_XDRDADJ("FL")
|
|---|
| 71 | S XDRDADJ("TOC")=XDRDADJ("TO")_";"_XDRDADJ("FL")
|
|---|
| 72 | Q
|
|---|
| 73 | ;
|
|---|
| 74 | XREFS ; GET XREFS LESS TRIGGERS
|
|---|
| 75 | 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)
|
|---|
| 76 | Q
|
|---|
| 77 | ;
|
|---|
| 78 | EOJ ;
|
|---|
| 79 | K XDRDADJ,XDRDADJY,XDRDXREF
|
|---|
| 80 | Q
|
|---|
