source: FOIAVistA/trunk/r/ZZREGIONAL-A1C-A5C-CRHD-RGED-RGUT-RGWB-RG/RGMTDPSC.m@ 949

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