Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: XDRDADJ

XDRDADJ.m

Go to the documentation of this file.
  1. XDRDADJ ;IHS/EDE/OHPRD;ADJUSTS DUPLICATE RECORD FILE UPON MERGE; [ 08/13/92 09:50 AM ]
  1. ;;7.3;TOOLKIT;;Apr 25, 1995
  1. START ;
  1. K XDRDADJ
  1. S XDRDADJ("DA")=DA
  1. 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
  1. D INIT
  1. D ENTRIES
  1. END D EOJ
  1. Q
  1. ;
  1. ;
  1. ENTRIES ; ADJUST ENTRIES
  1. 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
  1. Q
  1. ;
  1. ENTRY ; ADJUST ONE ENTRY
  1. S DA=XDRDADJY
  1. S XDRDADJ("PC")=$S($P(X,U,1)=XDRDADJ("FRC"):1,1:2)
  1. 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)
  1. S Y=0 F X="ANOT","APOT","AVDUP" S Y=$D(^VA(15,X,XDRDADJ("FL"),%)) Q:Y
  1. I Y D DIK Q
  1. D KILL
  1. S $P(^VA(15,DA,0),U,XDRDADJ("PC"))=XDRDADJ("TOC")
  1. D SET
  1. I $P(^VA(15,DA,0),U,2)=$P(^(0),U) D DIK Q
  1. S X="XDRDUP" X ^%ZOSF("TEST") I $T NEW XDRFL,XDRQFLG S XDRDPDA=XDRDADJY D EN^XDRDUP K XDRD,XDRDPDA ; Recompute duplicate score
  1. Q
  1. ;
  1. DIK ; CALL ^DIK TO DELETE ENTRY
  1. ; Delete entry because another entry has same pair.
  1. S DIK="^VA(15,"
  1. D ^DIK K DIK
  1. Q
  1. ;
  1. KILL ; DO KILL SIDE OF XREFS
  1. S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
  1. S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
  1. D KILL2
  1. S XDRDADJ("FLD")=.03
  1. S X=$P(^VA(15,DA,0),U,3)
  1. D KILL2
  1. Q
  1. ;
  1. KILL2 ;
  1. F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y X XDRDXREF(XDRDADJ("FLD"),Y,"K")
  1. Q
  1. ;
  1. SET ; DO SET SIDE OF XREFS
  1. S XDRDADJ("FLD")=$S(XDRDADJ("PC")=1:.01,1:.02)
  1. S X=$P(^VA(15,DA,0),U,XDRDADJ("PC"))
  1. D SET2
  1. S XDRDADJ("FLD")=.03
  1. S X=$P(^VA(15,DA,0),U,3)
  1. D SET2
  1. Q
  1. ;
  1. SET2 ;
  1. F Y=0:0 S Y=$O(XDRDXREF(XDRDADJ("FLD"),Y)) Q:Y'=+Y X XDRDXREF(XDRDADJ("FLD"),Y,"S")
  1. Q
  1. ;
  1. INIT ;
  1. S F=15 F X=.01,.02,.03 D XREFS ; Get xrefs less triggers
  1. S X=$P(^VA(15,XDRDADJ("DA"),0),U,1,4),%=$P(X,U,4)
  1. S XDRDADJ("FR")=+$P(X,U,%)
  1. S XDRDADJ("FPC")=%
  1. S XDRDADJ("TO")=+$P(X,U,%#2+1)
  1. S XDRDADJ("TPC")=%#2+1
  1. S XDRDADJ("FL")=$P($P(X,U,1),";",2)
  1. S XDRDADJ("FRC")=XDRDADJ("FR")_";"_XDRDADJ("FL")
  1. S XDRDADJ("TOC")=XDRDADJ("TO")_";"_XDRDADJ("FL")
  1. Q
  1. ;
  1. XREFS ; GET XREFS LESS TRIGGERS
  1. 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)
  1. Q
  1. ;
  1. EOJ ;
  1. K XDRDADJ,XDRDADJY,XDRDXREF
  1. Q