76 lines
2.6 KiB
Mathematica
76 lines
2.6 KiB
Mathematica
XDRDUP ;SF-IRMFO/IHS/OHPRD/JCM - COMPARES TWO RECORDS TO SEE IF DUP OF EACH OTHER; [ 08/13/92 09:50 AM ] ;04/30/2001 10:35
|
|
;;7.3;TOOLKIT;**23,46,49,56**;Apr 25, 1995
|
|
;;
|
|
START ;
|
|
K % S XDRQFLG=0
|
|
I '$D(XDRCD)!('$D(XDRCD2)) S XDRERR=7 D ^XDREMSG G END
|
|
I '$D(XDRDSCOR) D ^XDRDSCOR G:XDRQFLG END
|
|
F %="MAX","PDT" S XDRDSCOR(%)=0
|
|
S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")=0
|
|
D VALUE I $D(XDRCD2)'>1 Q
|
|
; sites are requesting to merge test patients, REMing next line
|
|
;I XDRFL=2,$E(XDRCD2(2,XDRCD2,.09,"I"),1,5)="00000" Q
|
|
D MAIN
|
|
END D EOJ
|
|
Q
|
|
;
|
|
MAIN ;
|
|
F XDRDUPFL=0:0 S XDRDUPFL=$O(XDRDSCOR("DR",XDRDUPFL)) Q:'XDRDUPFL D DIQ1
|
|
K XDRDUPFL
|
|
I $D(XDRCD2)'>0 S ^XTMP("XDRERR",2,XDRDTYPE,"NO DATA",XDRCD2)="" Q
|
|
S XDRD("DUPSCORE")=0
|
|
F XDRDTO=0:0 S XDRDTO=$O(XDRDTEST(XDRDTO)) Q:'XDRDTO!(XDRQFLG) D TEST
|
|
K XDRDTO F %=0:0 S %=$O(XDRCD2(%)) Q:'% K XDRCD2(%)
|
|
K %
|
|
S XDRDSCOR("PDT")="."_XDRDSCOR("PDT%")*XDRDSCOR("MAX")
|
|
S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")="."_XDRDSCOR("VDT%")*XDRDSCOR("MAX")
|
|
I XDRDSCOR("MAX")>0 D
|
|
. N J1,J2
|
|
. S J1=+$J(XDRD("DUPSCORE")/XDRDSCOR("MAX"),1,2)
|
|
. S (^(J1),J2)=$G(^TMP("XDRDUPSC",XDRFL,XDRDTYPE,J1))+1
|
|
. I J1>.6 S ^TMP("XDRDUPS1",XDRFL,XDRDTYPE,J1,J2)=XDRCD_U_XDRCD2
|
|
I '$D(XDRD("NOADD")),XDRD("DUPSCORE")'<XDRDSCOR("PDT"),'$D(XDRDCOMP) D ^XDRDADD
|
|
MAINX Q
|
|
;
|
|
DIQ1 ;
|
|
S DIC=XDRDUPFL,DIQ(0)="I",DR=XDRDSCOR("DR",XDRDUPFL)
|
|
I '$D(XDRCD(XDRDUPFL)) S DA=XDRCD,DIQ="XDRCD" D EN^DIQ1 K DA,D0
|
|
S DA=XDRCD2,DIQ="XDRCD2" D EN^DIQ1 K DIC,DR,DIQ,DA,D0
|
|
Q
|
|
;
|
|
TEST ;
|
|
S XDRD("TEST ROUTINE")=$S($P($P(XDRDTEST(XDRDTO),U,3),"-",2)]"":$P($P(XDRDTEST(XDRDTO),U,3),"-")_"^"_$P($P(XDRDTEST(XDRDTO),U,3),"-",2),1:U_$P(XDRDTEST(XDRDTO),U,3))
|
|
S X=$P(XDRD("TEST ROUTINE"),U,2) X ^%ZOSF("TEST") K X I '$T S XDRERR=8 D ^XDREMSG G TESTX
|
|
S XDRD("TEST SCORE")=0
|
|
D @XDRD("TEST ROUTINE")
|
|
S XDRDUP("TEST SCORE",XDRDTO)=XDRD("TEST SCORE")
|
|
S XDRD("DUPSCORE")=XDRD("DUPSCORE")+(XDRD("TEST SCORE"))
|
|
S:+XDRD("TEST SCORE")'=0 XDRDSCOR("MAX")=XDRDSCOR("MAX")+($P(XDRDTEST(XDRDTO),U,6))
|
|
TESTX K XDRD("TEST ROUTINE")
|
|
Q
|
|
;
|
|
EN ; EP - Called by XDRDADJ,XDRDPDTI
|
|
;
|
|
N XDRDTYPE
|
|
S XDRDTYPE="BASIC"
|
|
K XDRCD,XDRCD2
|
|
S XDRCD=+$P(^VA(15,XDRDPDA,0),U)
|
|
S XDRCD2=+$P(^VA(15,XDRDPDA,0),U,2)
|
|
S XDRFL=$O(^VA(15.1,"AGL",$P($P(^VA(15,XDRDPDA,0),U),";",2),0))
|
|
I 'XDRFL S XDRERR=6 D ^XDREMSG G ENX
|
|
S:XDRFL XDRD(0)=^VA(15.1,XDRFL,0)
|
|
D START
|
|
ENX Q
|
|
;
|
|
EOJ ;
|
|
I $D(XDRDPDA),'$D(XDRDPDTI) K XDRFL,XDRDSCOR,XDRDTEST,XDRD,XDRQFLG,XDRCD,XDRCD2
|
|
Q
|
|
VALUE ;
|
|
S DA=XDRCD2 K XDRCD2 S XDRCD2=DA
|
|
F XDRI=0:0 S XDRI=$O(XDRDSCOR("DR",XDRI)) Q:XDRI'>0 D
|
|
. S DIC=XDRI,DA=XDRCD2,DIQ(0)="I",DIQ="XX",DR=XDRDSCOR("DR",XDRI)
|
|
. K XX
|
|
. D EN^DIQ1
|
|
. M XDRCD2=XX K XX,DA,DIC,DR,DIQ
|
|
Q
|