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
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTDPSC 4509 printed Sep 23, 2025@19:18:17 Page 2
RGMTDPSC ;GAI/TMG-COUNT DUPLICATE RECORD ENTRIES BY CMOR SCORE RANGE ;5/30/98
+1 ;;1.0;CLINICAL INFO RESOURCE NETWORK;**19**;30 Apr 99
+2 ;
+3 ;Reference to ^VA(15 supported by IA #2532
+4 ;Reference to ^DPT("ACMORS" and ^DPT(0 supported by IA #2070
+5 ;
+6 ;; search the Duplicate Record file (#15) for duplicate pairs and
+7 ;; display by CMOR activity score range. The ranges are in 100's with
+8 ;; a separate range for pairs where both members have no score and where
+9 ;; both members have zero score or one member has a zero score and the
+10 ;; other has no score.
+11 ;;
EN ; que or select device for output
+1 IF '$DATA(^DPT("ACMORS"))
Begin DoDot:1
+2 WRITE !,"The option, Start/Restart CMOR Score Calculation"
+3 WRITE !,"[RG CMOR START], needs to be run before this option."
End DoDot:1
QUIT
+4 SET %ZIS="QM"
DO ^%ZIS
if POP
QUIT
if IO'=IO(0)
SET IO("Q")=""
IF '$DATA(IO("Q"))
GOTO SCAN
+5 SET ZTRTN="SCAN^RGMTDPSC"
+6 SET ZTIO=ION_";"_IOST_";"_IOM_";"_IOSL
SET ZTSAVE("IO*")=""
+7 SET ZTDESC="DUP. RECORD REPORT BY CMOR SCORE"
DO ^%ZTLOAD
DO EXIT
DO ^%ZISC
+8 QUIT
+9 ;
SCAN ; search and count duplicate pairs by score ranges
+1 SET U="^"
SET MSG=0
SET MSGLINE=1
SET DPTCNT=0
KILL SCRARR
+2 NEW NODE1,NODE2
+3 SET IEN=0
FOR
SET IEN=$ORDER(^VA(15,IEN))
if +IEN'>0
QUIT
IF $DATA(^VA(15,+IEN,0))
SET NODE=^(0)
Begin DoDot:1
+4 SET (SCRANGE,SCORE,SCORE1,SCORE2)="NO SCORE"
+5 SET DPT1=+$PIECE(NODE,U)
SET DPT2=+$PIECE(NODE,U,2)
+6 SET NODE1=$$MPINODE^MPIFAPI(+DPT1)
+7 IF $PIECE($GET(NODE1),U,6)'=""
SET SCORE1=$PIECE(NODE1,U,6)
+8 SET NODE2=$$MPINODE^MPIFAPI(+DPT2)
+9 IF $PIECE($GET(NODE2),U,6)'=""
SET SCORE2=$PIECE(NODE2,U,6)
+10 IF SCORE1=0&(SCORE2=0)
SET (SCRANGE,SCORE)="ZERO"
+11 IF SCORE1?.N!(SCORE2?.N)
Begin DoDot:2
+12 if SCRANGE="ZERO"
QUIT
+13 if +SCORE1>+SCORE
SET SCORE=SCORE1
if +SCORE2>+SCORE
SET SCORE=SCORE2
SET SCRANGE=SCORE\100
IF SCRANGE>0
SET SCRANGE=SCRANGE*100
End DoDot:2
+14 if '$DATA(SCRARR("RANGE",SCRANGE))
SET SCRARR("RANGE",SCRANGE)=0
+15 SET SCRARR("RANGE",SCRANGE)=SCRARR("RANGE",SCRANGE)+1
End DoDot:1
+16 DO PRINT
+17 ;
EXIT KILL COUNT,DPT1,DPT2,DPTCNT,IEN,MSG,MSGLINE,NODE,PAGE,POP,PRANGE,PRDT,SCORE
+1 KILL SCORE1,SCORE2,SCRANGE,SCRARR,S,TXT,X,Y,ZTDESC,ZTIO,ZTRTN,ZTSAVE,ZZ,%DT,%ZIS,DTOUT,DUOUT,SITE,XMSUB,XMTEXT,XMY,XMDUZ
+2 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+3 QUIT
+4 ;
PRINT ; print duplicate pair counts by score range
+1 SET (PAGE,COUNT)=0
SET X="N"
SET %DT="T"
DO ^%DT
SET X=Y
XECUTE ^DD("DD")
SET PRDT=Y
+2 DO HDR
IF MSG=0
DO MSG
+3 IF $DATA(SCRARR("RANGE","ZERO"))
Begin DoDot:1
+4 SET PRANGE="0"
WRITE !?10,PRANGE,?40,$JUSTIFY(SCRARR("RANGE","ZERO"),6,0)
+5 SET COUNT=COUNT+SCRARR("RANGE","ZERO")
End DoDot:1
+6 SET SCRANGE=""
FOR
SET SCRANGE=$ORDER(SCRARR("RANGE",SCRANGE))
if SCRANGE=""
QUIT
if SCRANGE="ZERO"
QUIT
Begin DoDot:1
+7 IF SCRANGE=0
SET PRANGE="1 - 99"
+8 IF SCRANGE'="NO SCORE"
IF SCRANGE>0
SET PRANGE=SCRANGE_" - "_(SCRANGE+99)
+9 IF SCRANGE="NO SCORE"
SET PRANGE=SCRANGE
+10 SET MSGLINE=MSGLINE+.001
+11 SET TXT(MSGLINE)=$JUSTIFY(" ",10)_PRANGE_$JUSTIFY(" ",23)_$JUSTIFY(SCRARR("RANGE",SCRANGE),6,0)
+12 if $Y>(IOSL-6)
DO HDR
WRITE !?10,PRANGE,?39,$JUSTIFY(SCRARR("RANGE",SCRANGE),6,0)
SET COUNT=COUNT+SCRARR("RANGE",SCRANGE)
End DoDot:1
+13 SET DPTCNT=$PIECE(^DPT(0),U,4)
+14 if $Y>(IOSL-6)
DO HDR
WRITE !!,"TOTAL Potential Duplicates (15): ",?39,$JUSTIFY(COUNT,6,0)
+15 if $Y>(IOSL-6)
DO HDR
WRITE !,"TOTAL Patients (2): ",?39,$JUSTIFY(DPTCNT,6,0)
+16 SET MSGLINE=MSGLINE+.001
Begin DoDot:1
+17 SET TXT(MSGLINE)=" "
SET MSGLINE=MSGLINE+.001
+18 SET TXT(MSGLINE)="TOTAL Potential Duplicates (15) "_COUNT
+19 SET MSGLINE=MSGLINE+.001
+20 SET TXT(MSGLINE)="TOTAL Patients (2) "_DPTCNT
End DoDot:1
+21 DO MSG1
+22 QUIT
+23 ;
HDR IF ($EXTRACT(IOST,1,2)="C-")&(IO=IO(0))
Begin DoDot:1
+1 SET DIR(0)="E"
DO ^DIR
KILL DIR
End DoDot:1
+2 if $DATA(DUOUT)!($DATA(DTOUT))
QUIT
+3 SET PAGE=PAGE+1
WRITE #
+4 WRITE "Duplicate Record Count by CMOR Score",?(IOM-23),"Page: ",PAGE
+5 WRITE !?(IOM-23),"Date: ",PRDT,!
+6 FOR ZZ=1:1:IOM
WRITE "-"
+7 IF PAGE=1
Begin DoDot:1
+8 WRITE !,"This report is drawn from the Duplicate Record file (#15) with"
+9 WRITE !,"CMOR scores from the PATIENT file, CMOR ACTIVITY SCORE field.",!
+10 WRITE !,"- If both members of a pair have a score of zero the pair is"
+11 WRITE !," counted in the '0' group."
+12 WRITE !,"- If one or both members of the pair have a score greater than"
+13 WRITE !," zero, that pair is counted in the group for the higher score."
+14 WRITE !,"- If neither member of the pair have a CMOR score, the pair is"
+15 WRITE !," counted in the 'NO SCORE' group."
End DoDot:1
+16 WRITE !!,?10,"Score Range",?40,"Count",!?10,"-----------",?40,"-----",!
+17 QUIT
MSG ;create the message
+1 SET TXT(.1)="Duplicate Record Count by CMOR Score"_$JUSTIFY(" ",20)_"Date: "_PRDT
+2 SET TXT(.2)=" "
+3 SET SITE=$$SITE^VASITE()
+4 SET TXT(.3)=$PIECE(SITE,U,2)_" ("_$PIECE(SITE,U)_")"
+5 SET TXT(.4)=" "
+6 SET TXT(.5)=$JUSTIFY(" ",10)_"Score Range"_$JUSTIFY(" ",20)_"Count"
+7 SET TXT(.6)=$JUSTIFY(" ",10)_"-----------"_$JUSTIFY(" ",20)_"-----"
+8 SET TXT(.7)=" "
+9 QUIT
MSG1 ;call XMD
+1 SET XMSUB="Duplicate Records by CMOR Score: "_$PIECE(SITE,U,2)
+2 SET XMY(DUZ)=""
SET XMDUZ=DUZ
+3 SET XMTEXT="TXT("
DO ^XMD
+4 QUIT
