| 1 | XDRDPICK ;SF-IRMFO.SEA/JLI - SELECT A PAIR OF POTENTIAL DUPLICATES AND VIEW ;07/27/2000 09:56
|
|---|
| 2 | ;;7.3;TOOLKIT;**23,47**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | EN ;
|
|---|
| 5 | N XDRFL,CMORS1,CMORS2,D0,DA,DIC,DIE,DIR,ICNT,ICNT1,JCNT,LCNT,NCNT,PNCT,TMPGLA,TMPGLB,XDRDA,XDRFILN,XDRGLB,Y,PRIFILE
|
|---|
| 6 | ; D EN^XDRVCHEK
|
|---|
| 7 | S XDRFL=$$FILE() Q:XDRFL'>0 S PRIFILE=XDRFL,XDRGLB=$P(^DIC(XDRFL,0,"GL"),U,2),XDRFILN=$P(^DIC(XDRFL,0),U)
|
|---|
| 8 | LOOP ;
|
|---|
| 9 | W !!!,"At the following prompt select a POTENTIAL DUPLICATE ENTRY. If a selection"
|
|---|
| 10 | W !,"is not made, you will be given a chance to select from a list if you"
|
|---|
| 11 | W !,"want to. Otherwise, you will be returned to the menu system."
|
|---|
| 12 | W !
|
|---|
| 13 | S Y=$$LOOKUP^XDRDEDT(XDRFL)
|
|---|
| 14 | S XDRDA=+Y I Y>0 D SHOW G LOOP
|
|---|
| 15 | S DIR(0)="Y"
|
|---|
| 16 | S DIR("A")="Do you want to select from a list of potential duplicates"
|
|---|
| 17 | S DIR("B")="YES"
|
|---|
| 18 | D ^DIR K DIR Q:Y'>0
|
|---|
| 19 | S TMPGLB=$NA(^TMP("XDRDPICK",$J)),TMPGLA=$NA(^TMP("XDRDPICA",$J))
|
|---|
| 20 | K @TMPGLB,@TMPGLA
|
|---|
| 21 | D ASK
|
|---|
| 22 | I XDRDA>0 G LOOP
|
|---|
| 23 | K PCNT
|
|---|
| 24 | Q
|
|---|
| 25 | ;
|
|---|
| 26 | GETLIST ;
|
|---|
| 27 | I XDRGLB="DPT(",$O(^DPT("ACMORS",0))>0 D CMORS Q
|
|---|
| 28 | N FLG
|
|---|
| 29 | F ICNT=ICNT:0 S ICNT=$O(^VA(15,ICNT)) Q:ICNT'>0 S X=^(ICNT,0) D Q:'(NCNT#4)&(NCNT>0)&FLG
|
|---|
| 30 | . S FLG=1 ;This flag is when NCNT is set from previous call and STATUS is not "P" the first time- - so loop will not quit with (NCNT#4)
|
|---|
| 31 | . I $P(X,U,3)'="P" S:PCNT=NCNT FLG=0 Q
|
|---|
| 32 | . I $P($P(X,U),";",2)'=XDRGLB Q
|
|---|
| 33 | . S NCNT=NCNT+1,X1=+$P(X,U),X2=+$P(X,U,2)
|
|---|
| 34 | . I '($D(@(U_XDRGLB_X1_",0)"))#2)!'($D(@(U_XDRGLB_X2_",0)"))#2) S NCNT=NCNT-1 Q
|
|---|
| 35 | . S @TMPGLB@(NCNT)=ICNT_U_X1_U_X2
|
|---|
| 36 | . S @TMPGLB@(NCNT,1)=@(U_XDRGLB_X1_",0)")
|
|---|
| 37 | . S @TMPGLB@(NCNT,2)=@(U_XDRGLB_X2_",0)")
|
|---|
| 38 | Q
|
|---|
| 39 | ;
|
|---|
| 40 | ASK ;
|
|---|
| 41 | S NCNT=0,ICNT=0,ICNT1=0,JCNT=0,XDRDA=0,PCNT=0
|
|---|
| 42 | F D D CHEK Q:XDRDA'=0 Q:JCNT'>0
|
|---|
| 43 | . D GETLIST
|
|---|
| 44 | . S PCNT=NCNT
|
|---|
| 45 | . F JCNT=JCNT:0 S JCNT=$O(@TMPGLB@(JCNT)) Q:JCNT'>0 D Q:'(JCNT#4)
|
|---|
| 46 | . . W !!!,$J(JCNT,5),". ",@TMPGLB@(JCNT,1)
|
|---|
| 47 | . . W !,?8,@TMPGLB@(JCNT,2)
|
|---|
| 48 | I XDRDA>0 S XDRDA=+@TMPGLB@(XDRDA) D SHOW
|
|---|
| 49 | Q
|
|---|
| 50 | ;
|
|---|
| 51 | CHEK ;
|
|---|
| 52 | W !
|
|---|
| 53 | I JCNT'>0 S DIR(0)="N"
|
|---|
| 54 | E S DIR(0)="NO",DIR("A",1)="Enter Return to continue listing or"
|
|---|
| 55 | S DIR("A")="Select the desired entry by number"
|
|---|
| 56 | S DIR(0)=DIR(0)_"^1:"_NCNT
|
|---|
| 57 | D ^DIR K DIR
|
|---|
| 58 | I Y>0 S XDRDA=+Y
|
|---|
| 59 | I $D(DUOUT)!$D(DTOUT) S XDRDA=-1 K DTOUT,DUOUT
|
|---|
| 60 | K DIRUT
|
|---|
| 61 | Q
|
|---|
| 62 | ;
|
|---|
| 63 | SHOW ;
|
|---|
| 64 | ;L +^VA(15,+XDRDA,0):30 I '$T G BUSY
|
|---|
| 65 | ;I $P(^VA(15,+XDRDA,0),U,3)'="P" L -^VA(15,+XDRDA,0) G BUSY ; NOT AVAILABLE
|
|---|
| 66 | ;N XDRXX S XDRXX(15,(+XDRDA)_",",.03)="X"
|
|---|
| 67 | ;D FILE^DIE("","XDRXX")
|
|---|
| 68 | ;L -^VA(15,+XDRDA,0)
|
|---|
| 69 | I '$D(XDRGLB) N XDRGLB S XDRGLB=$P($P(^VA(15,XDRDA,0),U),";",2)
|
|---|
| 70 | I $D(@(XDRGLB_(+^VA(15,XDRDA,0))_",-9)"))!$D(@(XDRGLB_(+$P(^VA(15,XDRDA,0),U,2))_",-9)")) W !,$C(7),"One of these entries has already been merged. Pick another pair.",!! D RESET(XDRDA) Q
|
|---|
| 71 | S XQAID=""
|
|---|
| 72 | S X=^VA(15,+XDRDA,0)
|
|---|
| 73 | S X1=+X,X2=+$P(X,U,2)
|
|---|
| 74 | I $$COUNT^XDRRMRG2(XDRFL,X1,X2)>1 S X1=X2,X2=+X
|
|---|
| 75 | S XQADATA=XDRDA_U_X1_";"_X2_U_"PRIMARY"_U_XDRFL
|
|---|
| 76 | D ^XDRRMRG1
|
|---|
| 77 | S DA=$$FIND1^DIC(15.02,","_XDRDA_",","X","PRIMARY")
|
|---|
| 78 | I DA>0 D
|
|---|
| 79 | . S X=$P(^VA(15,XDRDA,0),U,3)
|
|---|
| 80 | . I X="N"!(X="V") Q
|
|---|
| 81 | . S X=^VA(15,XDRDA,2,DA,0)
|
|---|
| 82 | . I $P(X,U,2)="V" D
|
|---|
| 83 | . . S DR=".03///X;.1///"_DT_";"
|
|---|
| 84 | . . S DIE="^VA(15,",DA=XDRDA D ^DIE K DIE,DR
|
|---|
| 85 | . . D SETUP^XDRRMRG1(XDRDA)
|
|---|
| 86 | . . D CHEKVER^XDRRMRG1
|
|---|
| 87 | Q
|
|---|
| 88 | ;
|
|---|
| 89 | BUSY ;
|
|---|
| 90 | W !!,$C(7),"Record is being processed by someone else.",!!
|
|---|
| 91 | Q
|
|---|
| 92 | ;
|
|---|
| 93 | FILE() ;
|
|---|
| 94 | N X
|
|---|
| 95 | S X=0
|
|---|
| 96 | F I=0:0 S I=$O(^VA(15.1,I)) Q:I'>0 S X=X+1,X(I)=""
|
|---|
| 97 | I X=1 Q $O(X(""))
|
|---|
| 98 | K DIC S DIC=15.1,DIC(0)="AEQM",DIC("A")="Which FILE are the potential duplicates in (e.g., PATIENT)? ",DIC("B")="PATIENT" D ^DIC K DIC
|
|---|
| 99 | Q +Y
|
|---|
| 100 | ;
|
|---|
| 101 | CMORS ; RETURN DATA RANKED BY CMORS (HIGH VALUES FIRST)
|
|---|
| 102 | I '$D(^VA(15,"ACMORS")) D SETCMOR
|
|---|
| 103 | I $G(^VA(15,"ACMORS",0))'>0 D SETCMOR
|
|---|
| 104 | I $G(^VA(15,"ACMORS",0))>0,$$FMDIFF^XLFDT(DT,^(0))>7 D ASKCMOR
|
|---|
| 105 | I ICNT1>0 S ICNT=ICNT-1
|
|---|
| 106 | S LCNT=0
|
|---|
| 107 | F ICNT=ICNT:0 S ICNT=$O(^VA(15,"ACMORS",ICNT)) Q:ICNT'>0 D Q:('(NCNT#4))&(LCNT>0)
|
|---|
| 108 | . F ICNT1=+ICNT1:0 S ICNT1=$O(^VA(15,"ACMORS",ICNT,ICNT1)) Q:ICNT1'>0 D Q:('(NCNT#4))&(LCNT>0)
|
|---|
| 109 | . . S X=$G(^VA(15,ICNT1,0)) Q:X="" Q:$P(X,U,3)'="P" S X1=+X,X2=+$P(X,U,2)
|
|---|
| 110 | . . I $D(@TMPGLA@(X1,X2)) Q
|
|---|
| 111 | . . S @TMPGLA@(X1,X2)=""
|
|---|
| 112 | . . S NCNT=NCNT+1,LCNT=LCNT+1
|
|---|
| 113 | . . S @TMPGLB@(NCNT)=ICNT1_U_X1_U_X2
|
|---|
| 114 | . . S CMORS1=$P($G(^DPT(X1,"MPI")),U,6),CMORS2=$P($G(^DPT(X2,"MPI")),U,6)
|
|---|
| 115 | . . S @TMPGLB@(NCNT,1)=@(U_XDRGLB_X1_",0)")_" (CMOR SCORE = "_$S(CMORS1="":"NULL",1:CMORS1)_")"
|
|---|
| 116 | . . S @TMPGLB@(NCNT,2)=@(U_XDRGLB_X2_",0)")_" (CMOR SCORE = "_$S(CMORS2="":"NULL",1:CMORS2)_")"
|
|---|
| 117 | Q
|
|---|
| 118 | ;
|
|---|
| 119 | SETCMOR ;
|
|---|
| 120 | N I,X,X1,X2,SCOR
|
|---|
| 121 | K ^VA(15,"ACMORS")
|
|---|
| 122 | F I=0:0 S I=$O(^VA(15,I)) Q:I'>0 S X=^(I,0) D
|
|---|
| 123 | . I $P(X,U,3)'="P" Q
|
|---|
| 124 | . I $P($P(X,U),";",2)'="DPT(" Q
|
|---|
| 125 | . S X1=+X,X2=+$P(X,U,2)
|
|---|
| 126 | . S SCOR=$P($G(^DPT(X1,"MPI")),U,6) I SCOR'>0 S SCOR=0
|
|---|
| 127 | . S ^VA(15,"ACMORS",(9999999-SCOR),I)=""
|
|---|
| 128 | . S SCOR=$P($G(^DPT(X2,"MPI")),U,6) I SCOR'>0 S SCOR=0
|
|---|
| 129 | . S ^VA(15,"ACMORS",(9999999-SCOR),I)=""
|
|---|
| 130 | S ^VA(15,"ACMORS",0)=DT
|
|---|
| 131 | Q
|
|---|
| 132 | ;
|
|---|
| 133 | ASKCMOR ;
|
|---|
| 134 | N DIR
|
|---|
| 135 | S DIR(0)="Y",DIR("A")="The CMOR scores for activity haven't been checked recently. Do you want to update these (It might take a couple of minutes)"
|
|---|
| 136 | S DIR("B")="YES"
|
|---|
| 137 | D ^DIR I Y>0 D SETCMOR
|
|---|
| 138 | Q
|
|---|
| 139 | ;
|
|---|
| 140 | SET1 ; HANDLES SETTING OF X-REF ON CMOR SCORES FOR POTENTIAL DUPLICATES
|
|---|
| 141 | I X'="P" Q
|
|---|
| 142 | N XDRXVAL,XDRXVAL1
|
|---|
| 143 | S XDRXVAL=^VA(15,D0,0)
|
|---|
| 144 | I $P($P(XDRXVAL,U),";",2)'="DPT(" Q
|
|---|
| 145 | S XDRXVAL1=$P($G(^DPT(+XDRXVAL,"MPI")),U,6) I XDRXVAL1="" S XDRXVAL1=-1
|
|---|
| 146 | S ^VA(15,"ACMORS",(9999999-XDRXVAL1),D0)=""
|
|---|
| 147 | S XDRXVAL1=$P($G(^DPT(+$P(XDRXVAL,U,2),"MPI")),U,6) I XDRXVAL1="" S XDRXVAL1=-1
|
|---|
| 148 | S ^VA(15,"ACMORS",(9999999-XDRXVAL1),D0)=""
|
|---|
| 149 | Q
|
|---|
| 150 | ;
|
|---|
| 151 | KILL1 ; HANDLES KILLING OF X-REF ON CMOR SCORES FOR POTENTIAL DUPLICATES
|
|---|
| 152 | I X'="P" Q
|
|---|
| 153 | N XDRXVAL,XDRXVAL1
|
|---|
| 154 | S XDRXVAL=^VA(15,D0,0)
|
|---|
| 155 | I $P($P(XDRXVAL,U),";",2)'="DPT(" Q
|
|---|
| 156 | S XDRXVAL1=+$P($G(^DPT(+XDRXVAL,"MPI")),U,6) I XDRXVAL1="" S XDRXVAL1=-1
|
|---|
| 157 | K ^VA(15,"ACMORS",(9999999-XDRXVAL1),D0)
|
|---|
| 158 | S XDRXVAL1=+$P($G(^DPT(+$P(XDRXVAL,U,2),"MPI")),U,6) I XDRXVAL1="" S XDRXVAL1=-1
|
|---|
| 159 | K ^VA(15,"ACMORS",(9999999-XDRXVAL1),D0)
|
|---|
| 160 | Q
|
|---|
| 161 | ;
|
|---|
| 162 | OTHERS ; CHECKS AND MARKS OTHER PAIRS SO ONLY ONE CAN BE PROCESSED AT A TIME
|
|---|
| 163 | Q ; NOT USED CURRENTLY
|
|---|
| 164 | ;
|
|---|
| 165 | ; P CLEAR ALL RELATED
|
|---|
| 166 | ;
|
|---|
| 167 | ; X MARK ALL RELATED
|
|---|
| 168 | ;
|
|---|
| 169 | ; V CLEAR TO
|
|---|
| 170 | ;
|
|---|
| 171 | ; O NOTHING
|
|---|
| 172 | ;
|
|---|
| 173 | ; R MARK ALL RELATED
|
|---|
| 174 | ;
|
|---|
| 175 | ; MERGED CLEAR TO REALIGN FROM
|
|---|
| 176 | I X="O" Q
|
|---|
| 177 | N OLDDA,OLDX S OLDDA=DA,OLDX=X N DA,X
|
|---|
| 178 | N XDRENTR,IENVAL,XDRPAIR,DONE,XDR0,STATUS,DIREC
|
|---|
| 179 | I $D(XDROTHER) Q
|
|---|
| 180 | N XDROTHER S XDROTHER=1
|
|---|
| 181 | I OLDX="P"!(OLDX="N") D Q
|
|---|
| 182 | . F XDRENTR=$P(^VA(15,OLDDA,0),U),$P(^VA(15,OLDDA,0),U,2) F IENVAL=0:0 S IENVAL=$O(^VA(15,"B",XDRENTR,IENVAL)) Q:IENVAL'>0 I IENVAL'=OLDDA,$P(^VA(15,IENVAL,0),U,3)="O" D
|
|---|
| 183 | . . ; Have to check on whether the other member of the pair in process as well.
|
|---|
| 184 | . . S XDRPAIR=$P(^VA(15,IENVAL,0),U) IF XDRPAIR=XDRENTR S XDRPAIR=$P(^(0),U,2)
|
|---|
| 185 | . . S DONE=0 F IENPAIR=0:0 S IENPAIR=$O(^VA(15,"B",XDRPAIR,IENPAIR)) Q:IENPAIR'>0 I IENPAIR'=IENVAL D Q:DONE
|
|---|
| 186 | . . . S XDR0=^VA(15,IENPAIR,0)
|
|---|
| 187 | . . . S STATUS=$P(XDR0,U,3)
|
|---|
| 188 | . . . I STATUS="X"!(STATUS="R") S DONE=1 Q
|
|---|
| 189 | . . . I STATUS="V" D Q:DONE
|
|---|
| 190 | . . . . S DIREC=$P(XDR0,U,4)
|
|---|
| 191 | . . . . I $P(XDR0,U,DIREC)=XDRPAIR S DONE=1 Q ; IT IS THE 'FROM' ENTRY
|
|---|
| 192 | . . . . Q
|
|---|
| 193 | . . . Q
|
|---|
| 194 | . . D RESET(IENVAL)
|
|---|
| 195 | . . Q
|
|---|
| 196 | . Q
|
|---|
| 197 | I OLDX="X"!(OLDX="R") D Q
|
|---|
| 198 | . F XDRENTR=$P(^VA(15,OLDDA,0),U),$P(^VA(15,OLDDA,0),U,2) F IENVAL=0:0 S IENVAL=$O(^VA(15,"B",XDRENTR,IENVAL)) Q:IENVAL'>0 I IENVAL'=OLDDA,$P(^VA(15,IENVAL,0),U,3)="P" D
|
|---|
| 199 | . . N XDRXX S XDRXX(15,IENVAL_",",.03)="O"
|
|---|
| 200 | . . D FILE^DIE("","XDRXX")
|
|---|
| 201 | . Q
|
|---|
| 202 | I OLDX="V"&$D(XDRDADJX) D Q ; IF MERGED (XDRDADJX IS SET IN XDRDAJD AND IS RUN BY A CROSS-REFERENCE FOR MERGE STATUS SET TO 'MERGED')
|
|---|
| 203 | . F XDRENTR=$P(^VA(15,OLDDA,0),U),$P(^VA(15,OLDDA,0),U,2) D
|
|---|
| 204 | . . S DIREC=$P(^VA(15,OLDDA,0),U,4)
|
|---|
| 205 | . . F IENVAL=0:0 S IENVAL=$O(^VA(15,"B",XDRENTR,IENVAL)) Q:IENVAL'>0 I IENVAL'=OLDDA,$P(^VA(15,IENVAL,0),U,3)="O" D
|
|---|
| 206 | . . . ; Have to check on whether the other member of the pair in process as well.
|
|---|
| 207 | . . . S XDRPAIR=$P(^VA(15,IENVAL,0),U) IF XDRPAIR=XDRENTR S XDRPAIR=$P(^(0),U,2)
|
|---|
| 208 | . . . S DONE=0 F IENPAIR=0:0 S IENPAIR=$O(^VA(15,"B",XDRPAIR,IENPAIR)) Q:IENPAIR'>0 I IENPAIR'=IENVAL D Q:DONE
|
|---|
| 209 | . . . . S XDR0=^VA(15,IENPAIR,0)
|
|---|
| 210 | . . . . S STATUS=$P(XDR0,U,3)
|
|---|
| 211 | . . . . I STATUS="X"!(STATUS="R") S DONE=1 Q
|
|---|
| 212 | . . . . I STATUS="V" D Q:DONE
|
|---|
| 213 | . . . . . S DIREC=$P(XDR0,U,4)
|
|---|
| 214 | . . . . . I $P(XDR0,U,DIREC)=XDRPAIR S DONE=1 Q ; IT IS THE 'FROM' ENTRY
|
|---|
| 215 | . . . . . Q
|
|---|
| 216 | . . . . Q
|
|---|
| 217 | . . . D RESET(IENVAL) ; RESET TO "P"
|
|---|
| 218 | . . . Q
|
|---|
| 219 | . . Q
|
|---|
| 220 | . Q
|
|---|
| 221 | Q
|
|---|
| 222 | ;
|
|---|
| 223 | RESET(DA) ;
|
|---|
| 224 | N XDRXX,IENS,X
|
|---|
| 225 | I $P(^VA(15,DA,0),U,5)>1 Q
|
|---|
| 226 | D NAME^XDRDEDT(DA)
|
|---|
| 227 | S X=^VA(15,DA,0)
|
|---|
| 228 | S IENS=DA_","
|
|---|
| 229 | S XDRXX(15,IENS,.03)="P"
|
|---|
| 230 | I $P(X,U,4)'="" S XDRXX(15,IENS,.04)="@"
|
|---|
| 231 | I $P(X,U,5)'="" S XDRXX(15,IENS,.05)="@"
|
|---|
| 232 | I $P(X,U,7)'="" S XDRXX(15,IENS,.07)="@"
|
|---|
| 233 | I $P(X,U,8)'="" S XDRXX(15,IENS,.08)="@"
|
|---|
| 234 | I $P(X,U,10)'="" S XDRXX(15,IENS,.1)="@"
|
|---|
| 235 | I $P(X,U,13)'="" S XDRXX(15,IENS,.13)="@"
|
|---|
| 236 | I $P(X,U,14)'="" S XDRXX(15,IENS,.14)="@"
|
|---|
| 237 | D FILE^DIE("","XDRXX")
|
|---|
| 238 | S:$D(DUZ) $P(^VA(15,DA,0),U,12)=DUZ
|
|---|
| 239 | K ^VA(15,DA,2)
|
|---|
| 240 | K ^VA(15,DA,3)
|
|---|
| 241 | Q
|
|---|
