- 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 Mar 13, 2025@20:46:57 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
