103 lines
4.3 KiB
Mathematica
103 lines
4.3 KiB
Mathematica
RGMTDPSC ;GAI/TMG-COUNT DUPLICATE RECORD ENTRIES BY CMOR SCORE RANGE ;5/30/98
|
|
;;1.0;CLINICAL INFO RESOURCE NETWORK;**19**;30 Apr 99
|
|
;
|
|
;Reference to ^VA(15 supported by IA #2532
|
|
;Reference to ^DPT("ACMORS" and ^DPT(0 supported by IA #2070
|
|
;
|
|
;; search the Duplicate Record file (#15) for duplicate pairs and
|
|
;; display by CMOR activity score range. The ranges are in 100's with
|
|
;; a separate range for pairs where both members have no score and where
|
|
;; both members have zero score or one member has a zero score and the
|
|
;; other has no score.
|
|
;;
|
|
EN ; que or select device for output
|
|
I '$D(^DPT("ACMORS")) D Q
|
|
. W !,"The option, Start/Restart CMOR Score Calculation"
|
|
. W !,"[RG CMOR START], needs to be run before this option."
|
|
S %ZIS="QM" D ^%ZIS Q:POP S:IO'=IO(0) IO("Q")="" I '$D(IO("Q")) G SCAN
|
|
S ZTRTN="SCAN^RGMTDPSC"
|
|
S ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL,ZTSAVE("IO*")=""
|
|
S ZTDESC="DUP. RECORD REPORT BY CMOR SCORE" D ^%ZTLOAD,EXIT,^%ZISC
|
|
Q
|
|
;
|
|
SCAN ; search and count duplicate pairs by score ranges
|
|
S U="^",MSG=0,MSGLINE=1,DPTCNT=0 K SCRARR
|
|
N NODE1,NODE2
|
|
S IEN=0 F S IEN=$O(^VA(15,IEN)) Q:+IEN'>0 I $D(^VA(15,+IEN,0)) S NODE=^(0) D
|
|
. S (SCRANGE,SCORE,SCORE1,SCORE2)="NO SCORE"
|
|
. S DPT1=+$P(NODE,U),DPT2=+$P(NODE,U,2)
|
|
. S NODE1=$$MPINODE^MPIFAPI(+DPT1)
|
|
. I $P($G(NODE1),U,6)'="" S SCORE1=$P(NODE1,U,6)
|
|
. S NODE2=$$MPINODE^MPIFAPI(+DPT2)
|
|
. I $P($G(NODE2),U,6)'="" S SCORE2=$P(NODE2,U,6)
|
|
. I SCORE1=0&(SCORE2=0) S (SCRANGE,SCORE)="ZERO"
|
|
. I SCORE1?.N!(SCORE2?.N) D
|
|
. . Q:SCRANGE="ZERO"
|
|
. . S:+SCORE1>+SCORE SCORE=SCORE1 S:+SCORE2>+SCORE SCORE=SCORE2 S SCRANGE=SCORE\100 I SCRANGE>0 S SCRANGE=SCRANGE*100
|
|
. S:'$D(SCRARR("RANGE",SCRANGE)) SCRARR("RANGE",SCRANGE)=0
|
|
. S SCRARR("RANGE",SCRANGE)=SCRARR("RANGE",SCRANGE)+1
|
|
D PRINT
|
|
;
|
|
EXIT K COUNT,DPT1,DPT2,DPTCNT,IEN,MSG,MSGLINE,NODE,PAGE,POP,PRANGE,PRDT,SCORE
|
|
K SCORE1,SCORE2,SCRANGE,SCRARR,S,TXT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZZ,%DT,%ZIS,DTOUT,DUOUT,SITE,XMSUB,XMTEXT,XMY,XMDUZ
|
|
S:$D(ZTQUEUED) ZTREQ="@"
|
|
Q
|
|
;
|
|
PRINT ; print duplicate pair counts by score range
|
|
S (PAGE,COUNT)=0 S X="N",%DT="T" D ^%DT S X=Y X ^DD("DD") S PRDT=Y
|
|
D HDR I MSG=0 D MSG
|
|
I $D(SCRARR("RANGE","ZERO")) D
|
|
. S PRANGE="0" W !?10,PRANGE,?40,$J(SCRARR("RANGE","ZERO"),6,0)
|
|
. S COUNT=COUNT+SCRARR("RANGE","ZERO")
|
|
S SCRANGE="" F S SCRANGE=$O(SCRARR("RANGE",SCRANGE)) Q:SCRANGE="" Q:SCRANGE="ZERO" D
|
|
. I SCRANGE=0 S PRANGE="1 - 99"
|
|
. I SCRANGE'="NO SCORE" I SCRANGE>0 S PRANGE=SCRANGE_" - "_(SCRANGE+99)
|
|
. I SCRANGE="NO SCORE" S PRANGE=SCRANGE
|
|
. S MSGLINE=MSGLINE+.001
|
|
. S TXT(MSGLINE)=$J(" ",10)_PRANGE_$J(" ",23)_$J(SCRARR("RANGE",SCRANGE),6,0)
|
|
. D:$Y>(IOSL-6) HDR W !?10,PRANGE,?39,$J(SCRARR("RANGE",SCRANGE),6,0) S COUNT=COUNT+SCRARR("RANGE",SCRANGE)
|
|
S DPTCNT=$P(^DPT(0),U,4)
|
|
D:$Y>(IOSL-6) HDR W !!,"TOTAL Potential Duplicates (15): ",?39,$J(COUNT,6,0)
|
|
D:$Y>(IOSL-6) HDR W !,"TOTAL Patients (2): ",?39,$J(DPTCNT,6,0)
|
|
S MSGLINE=MSGLINE+.001 D
|
|
. S TXT(MSGLINE)=" ",MSGLINE=MSGLINE+.001
|
|
. S TXT(MSGLINE)="TOTAL Potential Duplicates (15) "_COUNT
|
|
. S MSGLINE=MSGLINE+.001
|
|
. S TXT(MSGLINE)="TOTAL Patients (2) "_DPTCNT
|
|
D MSG1
|
|
Q
|
|
;
|
|
HDR I ($E(IOST,1,2)="C-")&(IO=IO(0)) D
|
|
. S DIR(0)="E" D ^DIR K DIR
|
|
Q:$D(DUOUT)!($D(DTOUT))
|
|
S PAGE=PAGE+1 W #
|
|
W "Duplicate Record Count by CMOR Score",?(IOM-23),"Page: ",PAGE
|
|
W !?(IOM-23),"Date: ",PRDT,!
|
|
F ZZ=1:1:IOM W "-"
|
|
I PAGE=1 D
|
|
.W !,"This report is drawn from the Duplicate Record file (#15) with"
|
|
.W !,"CMOR scores from the PATIENT file, CMOR ACTIVITY SCORE field.",!
|
|
.W !,"- If both members of a pair have a score of zero the pair is"
|
|
.W !," counted in the '0' group."
|
|
.W !,"- If one or both members of the pair have a score greater than"
|
|
.W !," zero, that pair is counted in the group for the higher score."
|
|
.W !,"- If neither member of the pair have a CMOR score, the pair is"
|
|
.W !," counted in the 'NO SCORE' group."
|
|
W !!,?10,"Score Range",?40,"Count",!?10,"-----------",?40,"-----",!
|
|
Q
|
|
MSG ;create the message
|
|
S TXT(.1)="Duplicate Record Count by CMOR Score"_$J(" ",20)_"Date: "_PRDT
|
|
S TXT(.2)=" "
|
|
S SITE=$$SITE^VASITE()
|
|
S TXT(.3)=$P(SITE,U,2)_" ("_$P(SITE,U)_")"
|
|
S TXT(.4)=" "
|
|
S TXT(.5)=$J(" ",10)_"Score Range"_$J(" ",20)_"Count"
|
|
S TXT(.6)=$J(" ",10)_"-----------"_$J(" ",20)_"-----"
|
|
S TXT(.7)=" "
|
|
Q
|
|
MSG1 ;call XMD
|
|
S XMSUB="Duplicate Records by CMOR Score: "_$P(SITE,U,2)
|
|
S XMY(DUZ)="",XMDUZ=DUZ
|
|
S XMTEXT="TXT(" D ^XMD
|
|
Q
|