| 1 | 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
|
|---|
| 2 | ;;7.3;TOOLKIT;**23,46,49,56**;Apr 25, 1995
|
|---|
| 3 | ;;
|
|---|
| 4 | START ;
|
|---|
| 5 | K % S XDRQFLG=0
|
|---|
| 6 | I '$D(XDRCD)!('$D(XDRCD2)) S XDRERR=7 D ^XDREMSG G END
|
|---|
| 7 | I '$D(XDRDSCOR) D ^XDRDSCOR G:XDRQFLG END
|
|---|
| 8 | F %="MAX","PDT" S XDRDSCOR(%)=0
|
|---|
| 9 | S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")=0
|
|---|
| 10 | D VALUE I $D(XDRCD2)'>1 Q
|
|---|
| 11 | ; sites are requesting to merge test patients, REMing next line
|
|---|
| 12 | ;I XDRFL=2,$E(XDRCD2(2,XDRCD2,.09,"I"),1,5)="00000" Q
|
|---|
| 13 | D MAIN
|
|---|
| 14 | END D EOJ
|
|---|
| 15 | Q
|
|---|
| 16 | ;
|
|---|
| 17 | MAIN ;
|
|---|
| 18 | F XDRDUPFL=0:0 S XDRDUPFL=$O(XDRDSCOR("DR",XDRDUPFL)) Q:'XDRDUPFL D DIQ1
|
|---|
| 19 | K XDRDUPFL
|
|---|
| 20 | I $D(XDRCD2)'>0 S ^XTMP("XDRERR",2,XDRDTYPE,"NO DATA",XDRCD2)="" Q
|
|---|
| 21 | S XDRD("DUPSCORE")=0
|
|---|
| 22 | F XDRDTO=0:0 S XDRDTO=$O(XDRDTEST(XDRDTO)) Q:'XDRDTO!(XDRQFLG) D TEST
|
|---|
| 23 | K XDRDTO F %=0:0 S %=$O(XDRCD2(%)) Q:'% K XDRCD2(%)
|
|---|
| 24 | K %
|
|---|
| 25 | S XDRDSCOR("PDT")="."_XDRDSCOR("PDT%")*XDRDSCOR("MAX")
|
|---|
| 26 | S:$D(XDRDSCOR("VDT%")) XDRDSCOR("VDT")="."_XDRDSCOR("VDT%")*XDRDSCOR("MAX")
|
|---|
| 27 | I XDRDSCOR("MAX")>0 D
|
|---|
| 28 | . N J1,J2
|
|---|
| 29 | . S J1=+$J(XDRD("DUPSCORE")/XDRDSCOR("MAX"),1,2)
|
|---|
| 30 | . S (^(J1),J2)=$G(^TMP("XDRDUPSC",XDRFL,XDRDTYPE,J1))+1
|
|---|
| 31 | . I J1>.6 S ^TMP("XDRDUPS1",XDRFL,XDRDTYPE,J1,J2)=XDRCD_U_XDRCD2
|
|---|
| 32 | I '$D(XDRD("NOADD")),XDRD("DUPSCORE")'<XDRDSCOR("PDT"),'$D(XDRDCOMP) D ^XDRDADD
|
|---|
| 33 | MAINX Q
|
|---|
| 34 | ;
|
|---|
| 35 | DIQ1 ;
|
|---|
| 36 | S DIC=XDRDUPFL,DIQ(0)="I",DR=XDRDSCOR("DR",XDRDUPFL)
|
|---|
| 37 | I '$D(XDRCD(XDRDUPFL)) S DA=XDRCD,DIQ="XDRCD" D EN^DIQ1 K DA,D0
|
|---|
| 38 | S DA=XDRCD2,DIQ="XDRCD2" D EN^DIQ1 K DIC,DR,DIQ,DA,D0
|
|---|
| 39 | Q
|
|---|
| 40 | ;
|
|---|
| 41 | TEST ;
|
|---|
| 42 | 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))
|
|---|
| 43 | S X=$P(XDRD("TEST ROUTINE"),U,2) X ^%ZOSF("TEST") K X I '$T S XDRERR=8 D ^XDREMSG G TESTX
|
|---|
| 44 | S XDRD("TEST SCORE")=0
|
|---|
| 45 | D @XDRD("TEST ROUTINE")
|
|---|
| 46 | S XDRDUP("TEST SCORE",XDRDTO)=XDRD("TEST SCORE")
|
|---|
| 47 | S XDRD("DUPSCORE")=XDRD("DUPSCORE")+(XDRD("TEST SCORE"))
|
|---|
| 48 | S:+XDRD("TEST SCORE")'=0 XDRDSCOR("MAX")=XDRDSCOR("MAX")+($P(XDRDTEST(XDRDTO),U,6))
|
|---|
| 49 | TESTX K XDRD("TEST ROUTINE")
|
|---|
| 50 | Q
|
|---|
| 51 | ;
|
|---|
| 52 | EN ; EP - Called by XDRDADJ,XDRDPDTI
|
|---|
| 53 | ;
|
|---|
| 54 | N XDRDTYPE
|
|---|
| 55 | S XDRDTYPE="BASIC"
|
|---|
| 56 | K XDRCD,XDRCD2
|
|---|
| 57 | S XDRCD=+$P(^VA(15,XDRDPDA,0),U)
|
|---|
| 58 | S XDRCD2=+$P(^VA(15,XDRDPDA,0),U,2)
|
|---|
| 59 | S XDRFL=$O(^VA(15.1,"AGL",$P($P(^VA(15,XDRDPDA,0),U),";",2),0))
|
|---|
| 60 | I 'XDRFL S XDRERR=6 D ^XDREMSG G ENX
|
|---|
| 61 | S:XDRFL XDRD(0)=^VA(15.1,XDRFL,0)
|
|---|
| 62 | D START
|
|---|
| 63 | ENX Q
|
|---|
| 64 | ;
|
|---|
| 65 | EOJ ;
|
|---|
| 66 | I $D(XDRDPDA),'$D(XDRDPDTI) K XDRFL,XDRDSCOR,XDRDTEST,XDRD,XDRQFLG,XDRCD,XDRCD2
|
|---|
| 67 | Q
|
|---|
| 68 | VALUE ;
|
|---|
| 69 | S DA=XDRCD2 K XDRCD2 S XDRCD2=DA
|
|---|
| 70 | F XDRI=0:0 S XDRI=$O(XDRDSCOR("DR",XDRI)) Q:XDRI'>0 D
|
|---|
| 71 | . S DIC=XDRI,DA=XDRCD2,DIQ(0)="I",DIQ="XX",DR=XDRDSCOR("DR",XDRI)
|
|---|
| 72 | . K XX
|
|---|
| 73 | . D EN^DIQ1
|
|---|
| 74 | . M XDRCD2=XX K XX,DA,DIC,DR,DIQ
|
|---|
| 75 | Q
|
|---|
