RGMTDPCT ;GAI/TMG-Count Entries for ^DPT in Dup. Record file ;3-11-98
;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
;; Counts duplicate entries for ^DPT in Duplicate Record file by each
;; of the following and then by the match percentile.
;; - STATUS (verification status)
;; P = potential duplicate
;; N = verified, not a duplicate
;; V = verified duplicate
;; X = verification in progress
;; R = required review
;; - MERGE STATUS - 0 = not ready
;; 1 = ready
;; 2 = merged
;; 3 = in progress
;;
START W !,"Duplicate Record File Statistics Scan",!
I '$D(DUZ) W !!,"Your user identification is not set. Please D ^XUP and try again." Q
S USER=DUZ,ZTIO="",ZTRTN="SCAN^RGMTDPCT",ZTDESC="Duplicate Record Statistics Search"
S ZTSAVE("USER")="" D ^%ZTLOAD I $D(ZTSK) W !," Task# ",ZTSK," queued to run." D ^%ZISC,KILL
S:$D(ZTQUEUED) ZTREQ="@"
Q
;;
SCAN K ^XTMP("RGMTDPCT") S U="^"
;set purge date of XTMP = 30 days
S ^XTMP("RGMTDPCT",0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT_U_"DUPLICATE RECORD CHECK"
S ^XTMP("RGMTDPCT","@@@@","STARTED")=$$NOW^XLFDT
S (^XTMP("RGMTDPCT","@@@@","SITE"),SITE)=$$SITE^VASITE()
S IEN=0 F S IEN=$O(^VA(15,IEN)) Q:+IEN'>0 I $D(^VA(15,+IEN,0)) S NODE0=^(0) D
.S ^XTMP("RGMTDPCT","@@@@","CURR IEN")=IEN
.S (VSTAT,MSTAT)="ZZZ" S:$P(NODE0,U,3)'="" VSTAT=$P(NODE0,U,3) S:$P(NODE0,U,5)'="" MSTAT=$P(NODE0,U,5)
.S MPERC=(($P(NODE0,U,19))\10)*10
.S:'$D(^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)) ^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)=0 S ^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)=^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)+1
.S:'$D(^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)) ^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)=0 S ^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)=^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)+1
;
MSG ;
S X=^XTMP("RGMTDPCT","@@@@","STARTED")
S %DT="T" D ^%DT S X=Y X ^DD("DD") S MSGDT=Y
S BLANKS=" "
S TXT(.1)="Duplicate Record (^DPT) Statistics"_$J(" ",15)_"Run Date: "_MSGDT
S TXT(.2)=""
S TXT(.3)=$P(SITE,U,2)_" ("_$P(SITE,U)_")"
S TXT(.4)=""
S TXT(.5)=" Counts by: Merge Status and Match Percentile:"
S LINE=1,STATUS="" F S STATUS=$O(^XTMP("RGMTDPCT","MERGE",STATUS)) Q:STATUS="" D
.S MSGSTAT=$S(STATUS=0:"NOT READY",STATUS=1:"READY",STATUS=2:"MERGED",STATUS=3:"IN PROGRESS",STATUS="ZZZ":"UNKNOWN")
. S LINE=LINE+.001
. S TXT(LINE)=""
. S LINE=LINE+.001 S TXT(LINE)=" Merge Status: "_MSGSTAT
.S PERC=0 F S PERC=$O(^XTMP("RGMTDPCT","MERGE",STATUS,PERC)) Q:+PERC'>0 S COUNT=^(PERC) D
. . S LINE=LINE+.001
. . S TEXT=" Percentile: "_PERC_BLANKS,TEXT=$E(TEXT,1,30),TEXT=TEXT_COUNT
. . S TXT(LINE)=TEXT
S LINE=2,LINE=LINE+.001 S TXT(LINE)=""
S LINE=LINE+.001
S TXT(LINE)=" Counts by: Verification Status and Match Percentile:"
S STATUS="" F S STATUS=$O(^XTMP("RGMTDPCT","VERIF",STATUS)) Q:STATUS="" D
. S MSGSTAT=$S(STATUS="P":"POTENTIAL DUP., UNVERIF",STATUS="N":"VERIFIED, NOT A DUPLICATE",STATUS="V":"VERIFIED DUPLICATE",STATUS="X":"VERIF. IN PROGRESS",STATUS="R":"REQUIRES RESOLUTION",1:"")
. S LINE=LINE+.001,TXT(LINE)=""
. S LINE=LINE+.001,TXT(LINE)=" Verification Status: "_MSGSTAT
. S PERC=0 F S PERC=$O(^XTMP("RGMTDPCT","VERIF",STATUS,PERC)) Q:+PERC'>0 S COUNT=^(PERC) D
. . S LINE=LINE+.001
. . S TEXT=" Percentile: "_PERC_BLANKS,TEXT=$E(TEXT,1,30),TEXT=TEXT_COUNT
. . S TXT(LINE)=TEXT
S (XMY(DUZ),XMY(USER))="",(XMDUZ)=DUZ
S XMSUB="Duplicate Record Counts: "_$P(SITE,U,2)
S XMTEXT="TXT(" D ^XMD
;
KILL K ^XTMP("RGMTDPCT"),BLANKS,COUNT,IEN,LINE,MPERC,MSGDT,MSGSTAT,MSTAT,NODE0
K PERC,SITE,STATUS,TEXT,TXT,USER,VSTAT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTSAVE
K ZTDESC,ZTIO,ZTRTN,ZTSK,%DT
Q
--- Routine Detail --- with STRUCTURED ROUTINE LISTING ---[H[J[2J[HRGMTDPCT 3840 printed Sep 23, 2025@19:18:16 Page 2
RGMTDPCT ;GAI/TMG-Count Entries for ^DPT in Dup. Record file ;3-11-98
+1 ;;1.0; CLINICAL INFO RESOURCE NETWORK ;;30 Apr 99
+2 ;; Counts duplicate entries for ^DPT in Duplicate Record file by each
+3 ;; of the following and then by the match percentile.
+4 ;; - STATUS (verification status)
+5 ;; P = potential duplicate
+6 ;; N = verified, not a duplicate
+7 ;; V = verified duplicate
+8 ;; X = verification in progress
+9 ;; R = required review
+10 ;; - MERGE STATUS - 0 = not ready
+11 ;; 1 = ready
+12 ;; 2 = merged
+13 ;; 3 = in progress
+14 ;;
START WRITE !,"Duplicate Record File Statistics Scan",!
+1 IF '$DATA(DUZ)
WRITE !!,"Your user identification is not set. Please D ^XUP and try again."
QUIT
+2 SET USER=DUZ
SET ZTIO=""
SET ZTRTN="SCAN^RGMTDPCT"
SET ZTDESC="Duplicate Record Statistics Search"
+3 SET ZTSAVE("USER")=""
DO ^%ZTLOAD
IF $DATA(ZTSK)
WRITE !," Task# ",ZTSK," queued to run."
DO ^%ZISC
DO KILL
+4 if $DATA(ZTQUEUED)
SET ZTREQ="@"
+5 QUIT
+6 ;;
SCAN KILL ^XTMP("RGMTDPCT")
SET U="^"
+1 ;set purge date of XTMP = 30 days
+2 SET ^XTMP("RGMTDPCT",0)=$$FMADD^XLFDT($$NOW^XLFDT,30)_U_$$NOW^XLFDT_U_"DUPLICATE RECORD CHECK"
+3 SET ^XTMP("RGMTDPCT","@@@@","STARTED")=$$NOW^XLFDT
+4 SET (^XTMP("RGMTDPCT","@@@@","SITE"),SITE)=$$SITE^VASITE()
+5 SET IEN=0
FOR
SET IEN=$ORDER(^VA(15,IEN))
if +IEN'>0
QUIT
IF $DATA(^VA(15,+IEN,0))
SET NODE0=^(0)
Begin DoDot:1
+6 SET ^XTMP("RGMTDPCT","@@@@","CURR IEN")=IEN
+7 SET (VSTAT,MSTAT)="ZZZ"
if $PIECE(NODE0,U,3)'=""
SET VSTAT=$PIECE(NODE0,U,3)
if $PIECE(NODE0,U,5)'=""
SET MSTAT=$PIECE(NODE0,U,5)
+8 SET MPERC=(($PIECE(NODE0,U,19))\10)*10
+9 if '$DATA(^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC))
SET ^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)=0
SET ^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)=^XTMP("RGMTDPCT","VERIF",VSTAT,MPERC)+1
+10 if '$DATA(^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC))
SET ^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)=0
SET ^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)=^XTMP("RGMTDPCT","MERGE",MSTAT,MPERC)+1
End DoDot:1
+11 ;
MSG ;
+1 SET X=^XTMP("RGMTDPCT","@@@@","STARTED")
+2 SET %DT="T"
DO ^%DT
SET X=Y
XECUTE ^DD("DD")
SET MSGDT=Y
+3 SET BLANKS=" "
+4 SET TXT(.1)="Duplicate Record (^DPT) Statistics"_$JUSTIFY(" ",15)_"Run Date: "_MSGDT
+5 SET TXT(.2)=""
+6 SET TXT(.3)=$PIECE(SITE,U,2)_" ("_$PIECE(SITE,U)_")"
+7 SET TXT(.4)=""
+8 SET TXT(.5)=" Counts by: Merge Status and Match Percentile:"
+9 SET LINE=1
SET STATUS=""
FOR
SET STATUS=$ORDER(^XTMP("RGMTDPCT","MERGE",STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+10 SET MSGSTAT=$SELECT(STATUS=0:"NOT READY",STATUS=1:"READY",STATUS=2:"MERGED",STATUS=3:"IN PROGRESS",STATUS="ZZZ":"UNKNOWN")
+11 SET LINE=LINE+.001
+12 SET TXT(LINE)=""
+13 SET LINE=LINE+.001
SET TXT(LINE)=" Merge Status: "_MSGSTAT
+14 SET PERC=0
FOR
SET PERC=$ORDER(^XTMP("RGMTDPCT","MERGE",STATUS,PERC))
if +PERC'>0
QUIT
SET COUNT=^(PERC)
Begin DoDot:2
+15 SET LINE=LINE+.001
+16 SET TEXT=" Percentile: "_PERC_BLANKS
SET TEXT=$EXTRACT(TEXT,1,30)
SET TEXT=TEXT_COUNT
+17 SET TXT(LINE)=TEXT
End DoDot:2
End DoDot:1
+18 SET LINE=2
SET LINE=LINE+.001
SET TXT(LINE)=""
+19 SET LINE=LINE+.001
+20 SET TXT(LINE)=" Counts by: Verification Status and Match Percentile:"
+21 SET STATUS=""
FOR
SET STATUS=$ORDER(^XTMP("RGMTDPCT","VERIF",STATUS))
if STATUS=""
QUIT
Begin DoDot:1
+22 SET MSGSTAT=$SELECT(STATUS="P":"POTENTIAL DUP., UNVERIF",STATUS="N":"VERIFIED, NOT A DUPLICATE",STATUS="V":"VERIFIED DUPLICATE",STATUS="X":"VERIF. IN PROGRESS",STATUS="R":"REQUIRES RESOLUTION",1:"")
+23 SET LINE=LINE+.001
SET TXT(LINE)=""
+24 SET LINE=LINE+.001
SET TXT(LINE)=" Verification Status: "_MSGSTAT
+25 SET PERC=0
FOR
SET PERC=$ORDER(^XTMP("RGMTDPCT","VERIF",STATUS,PERC))
if +PERC'>0
QUIT
SET COUNT=^(PERC)
Begin DoDot:2
+26 SET LINE=LINE+.001
+27 SET TEXT=" Percentile: "_PERC_BLANKS
SET TEXT=$EXTRACT(TEXT,1,30)
SET TEXT=TEXT_COUNT
+28 SET TXT(LINE)=TEXT
End DoDot:2
End DoDot:1
+29 SET (XMY(DUZ),XMY(USER))=""
SET (XMDUZ)=DUZ
+30 SET XMSUB="Duplicate Record Counts: "_$PIECE(SITE,U,2)
+31 SET XMTEXT="TXT("
DO ^XMD
+32 ;
KILL KILL ^XTMP("RGMTDPCT"),BLANKS,COUNT,IEN,LINE,MPERC,MSGDT,MSGSTAT,MSTAT,NODE0
+1 KILL PERC,SITE,STATUS,TEXT,TXT,USER,VSTAT,X,XMDUZ,XMSUB,XMTEXT,XMY,Y,ZTSAVE
+2 KILL ZTDESC,ZTIO,ZTRTN,ZTSK,%DT
+3 QUIT
