84 lines
2.9 KiB
Mathematica
84 lines
2.9 KiB
Mathematica
XDRDCOMP ;SF-IRMFO/IHS/OHPRD/JCM - COMPARE TWO PATIENTS VIA DUP CHECKER ;12/1/97 16:34
|
|
;;7.3;TOOLKIT;**23**;Apr 25, 1995
|
|
;;
|
|
; This routine will compare two records (patients), and will result with
|
|
; a score (0 - 100%) as to how they match up. You can not compare the
|
|
; same record.
|
|
;
|
|
START ;
|
|
S XDRQFLG=0
|
|
S XDRFL=$$FILE^XDRDPICK() Q:XDRFL'>0
|
|
G:XDRQFLG END
|
|
S XDRGL=^DIC(XDRFL,0,"GL")
|
|
S XDRDTYPE="BASIC" ; ADDED 4/11/96 JLI
|
|
D LKUP G:XDRQFLG END
|
|
S %ZIS="Q" D ^%ZIS G:POP END
|
|
S (IOP,XDRDCOMP("DEVICE"))=ION_";"_IOM_";"_IOSL
|
|
I $D(IO("Q")) D G:XDRQFLG END
|
|
.S ZTRTN="DQ^XDRDCOMP",ZTIO=ION,ZTDESC=$P(^DIC(XDRFL,0),U)_" COMPARISON LIST"
|
|
.F %="XDRCD","XDRCD2","XDRFL","XDRDTYPE","XDRGL","XDRD(","XDRDCOMP(" S ZTSAVE(%)=""
|
|
.D ^%ZTLOAD W:$D(ZTSK) !,"Queued as task "_ZTSK,!
|
|
.S XDRQFLG=1
|
|
DQ ; Entry Point for Taskman
|
|
U IO W @IOF
|
|
D ^XDRDSCOR
|
|
D ^XDRDUP ;S XDRD("NOADD")="" D ^XDRDUP
|
|
D DITC
|
|
D SCORE
|
|
D ^%ZISC
|
|
END D EOJ
|
|
Q
|
|
;
|
|
LKUP ;Look up both reocord.
|
|
S DIC=XDRGL,DIC(0)="QEAM"
|
|
S DIC("A")="COMPARE "_$P(^DIC(XDRFL,0),U)_": "
|
|
D ^DIC ;W !,"X: ",X,"Y: ",Y
|
|
I $D(DIRUT)!(Y=-1) K DIC,DA S XDRQFLG=1 G LKUPX
|
|
S XDRCD=+Y S DIT(1)=+Y
|
|
LKUP2 S DIC("A")=" WITH "_$P(^DIC(XDRFL,0),U)_": "
|
|
D ^DIC K DIC,DA
|
|
G:$D(DIRUT)!(Y=-1) LKUP
|
|
S XDRCD2=+Y S DIT(2)=+Y
|
|
I XDRCD=XDRCD2 W *7,!!," CAN NOT COMPARE SAME PATIENT!! ",!! G LKUP
|
|
LKUPX Q
|
|
;
|
|
DITC ;
|
|
D SHOW^XDRDSHOW(XDRFL,XDRCD,XDRCD2)
|
|
;S DFF=XDRFL,DIC=XDRGL,DIT(1)=XDRCD,DIT(2)=XDRCD2,DDIF=2
|
|
;S IOP=XDRDCOMP("DEVICE")
|
|
;D EN^DITC K DIC,DFF,DIT,IOP,DDIF
|
|
Q
|
|
SCORE ;
|
|
S:XDRDSCOR("MAX")>0 XDRD("DUPSCORE%")=XDRD("DUPSCORE")/XDRDSCOR("MAX")
|
|
S:XDRDSCOR("MAX")=0 XDRD("DUPSCORE%")=0
|
|
S XDRD("DUPSCORE%")=$J(XDRD("DUPSCORE%"),1,2)
|
|
S XDRD("DUPSCORE%")=$S(XDRD("DUPSCORE%")<0:0,XDRD("DUPSCORE%")<1:$E(XDRD("DUPSCORE%"),3,4),1:100)
|
|
;S IOP=XDRDCOMP("DEVICE") D ^%ZIS U IO
|
|
W !! F I=0:0 S I=$O(XDRDUP("TEST SCORE",I)) Q:I'>0 I +XDRDUP("TEST SCORE",I)'=0 S J=XDRDTEST(I) W !,$P(J,U),?25,"VALUE = ",$J(XDRDUP("TEST SCORE",I),3,0)," MAX POSSIBLE = ",$J($P(J,U,6),3,0)
|
|
W !!,?40,"DUPLICATE THRESHOLD % ",XDRDSCOR("PDT%")
|
|
W !,?40,"DUPLICATE SCORE % ",$G(XDRD("DUPSCORE%")),!
|
|
K %,XDRDCNT
|
|
I '$D(ZTQUEUED),$E(IOST,1,2)'="P-" S DIR(0)="E" D ^DIR K DIR S:X=U XDRQFLG=1
|
|
;D ^%ZISC
|
|
Q
|
|
QUEUE ;** Remove after testing **
|
|
I '$D(IOP),'$D(XDRDCOMP("DEVICE")) S %ZIS="QMN" D ^%ZIS
|
|
I POP S XDRQFLG=1 G QUEUEX
|
|
I $D(IO("Q")),IO=IO(0) W !!,"Sorry, you can't queue to your screen or a slave device.",! K IO("Q") G QUEUE
|
|
S (IOP,XDRDCOMP("DEVICE"))=ION_";"_IOM_";"_IOSL K %ZIS
|
|
I '$D(IO("Q")) G QUEUEX
|
|
S ZTRTN="DQ^XDRDCOMP",ZTIO=ION,ZTDESC=$P(^DIC(XDRFL,0),U)_" COMPARISON LIST"
|
|
F %="XDRCD","XDRCD2","XDRFL","XDRDTYPE","XDRGL","XDRD(","XDRDCOMP(" S ZTSAVE(%)=""
|
|
K %
|
|
;S XYY=AAA ***************************
|
|
D ^%ZTLOAD W:$D(ZTSK) !,"Queued as task "_ZTSK,!
|
|
S XDRQFLG=1
|
|
K ZTSK
|
|
QUEUEX Q
|
|
;
|
|
EOJ ;
|
|
K XDRDCOMP,XDRDUP,XDRD,XDRFL,XDRGL,XDRQFLG,XDRDTEST,XDRDSCOR
|
|
K XDRCD,XDRCD2,%IS,POP,IO("C"),IOP,IO("Q"),X,Y,ZTSK
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|