APCDDDPE ; IHS/CMI/LAB - delete dupe pt ed
;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
;; ;
W !!,"Looking for visits with Duplicate Patient Education Topics"
W !!,"Please enter a starting visit date to look for visits with duplicate"
W !,"V Patient Education entries. The issue with duplicate education "
W !,"started sometime in 2015 so you might want to start with 01/01/2015.",!!
K APCDPESD
S DIR(0)="D^:DT:EP",DIR("A")="Enter starting visit date for search" KILL DA D ^DIR KILL DIR
I $D(DIRUT) D EOJ Q
S APCDPESD=Y
S APCDPESD=$$FMADD^XLFDT(APCDPESD,-1)_".9999"
S APCDPEV=0,APCDC=0
S APCDMAX=0,APCDTOT=0
K APCDIWTQ
;GET STARTING DATE
F S APCDPESD=$O(^AUPNVSIT("B",APCDPESD)) Q:APCDPESD=""!($G(APCDIWTQ)) D CHK
Q
CHK ;
S APCDPEV=0 F S APCDPEV=$O(^AUPNVSIT("B",APCDPESD,APCDPEV)) Q:APCDPEV'=+APCDPEV!($G(APCDIWTQ)) D
.Q:'$D(^AUPNVPED("AD",APCDPEV)) ;no patient ed
.Q:'$D(^AUPNVSIT(APCDPEV,0)) ;bad xref
.Q:$P(^AUPNVSIT(APCDPEV,0),U,7)="H" ;no hospital
.Q:$P(^AUPNVSIT(APCDPEV,0),U,7)="I"
.S APCDX=0,APCDC=0,APCDZU=0
.K APCDZPED,APCDZDUP
.F S APCDX=$O(^AUPNVPED("AD",APCDPEV,APCDX)) Q:APCDX'=+APCDX D
..S Y=$$VALI^XBDIQ1(9000010.16,APCDX,.01) ;INTERNAL OF TOPIC
..S P=$$VALI^XBDIQ1(9000010.16,APCDX,.05) ;INTERNAL OF EDUCATION PROVIDER
..I 'P S P=$$VALI^XBDIQ1(9000010.16,APCDX,1204) ;INTERNAL OF ENCOUNTER PROVIDER
..I 'P Q ;no provider, not created by EHR so skip it
..I $D(APCDZPED(Y,P)) S APCDZDUP(APCDX)="IEN: "_APCDX_U_$$VAL^XBDIQ1(9000010.16,APCDX,.01)_U_Y_$$VAL^XBDIQ1(9000010.16,APCDX,1204)_U_P S $P(APCDZPED(Y,P),U,10)=$P(APCDZPED(Y,P),U,10)+1 Q
..S APCDZU=APCDZU+1,APCDZPED(Y,P)="IEN: "_APCDX_" "_$$VAL^XBDIQ1(9000010.16,APCDX,.01)_" "_$$VAL^XBDIQ1(9000010.16,APCDX,1204) Q
.I '$D(APCDZDUP) Q ;NO DUPES
.W !!,$$FMTE^XLFDT($$VD^APCLV(APCDPEV))," HRN: ",$$HRN^AUPNPAT($P(^AUPNVSIT(APCDPEV,0),U,5),DUZ(2))," ",$$CLINIC^APCLV(APCDPEV,"E")," ",$$PRIMPROV^APCLV(APCDPEV,"N")
.W !,"There are ",APCDZU," unique topic/provider codes on this visit:"
.S X=0 F S X=$O(APCDZPED(X)) Q:X'=+X S P=0 F S P=$O(APCDZPED(X,P)) Q:P'=+P D
..W !,$P(APCDZPED(X,P),U,1)," (# of duplicates: "_+$P(APCDZPED(X,P),U,10)_")"
..Q
.S DIR(0)="Y",DIR("A")="Would you like to display the visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) K APCDZPED,APCDZDUP G DEL
.I Y S APCDVSIT=APCDPEV D EN^APCDVD K APCDVSIT
DEL .;
.W !! K DIR S DIR(0)="Y",DIR("A")="Would you like to delete the duplicates",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) G MORE
.I 'Y G MORE
.;
.S APCDX=0 F S APCDX=$O(APCDZDUP(APCDX)) Q:APCDX'=+APCDX D
..;set log
..M ^APCDVPED(APCDX)=^AUPNVPED(APCDX)
..S DA=APCDX,DIK="^APCDVPED(" D IX^DIK K DIK,DA
..S DA=APCDX,DIK="^AUPNVPED(" D ^DIK K DA,DIK ;delete v patient ed
.S DIR(0)="Y",DIR("A")="Deletion complete, would you like to re-display the visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) G MORE
.I 'Y G MORE
.S APCDVSIT=APCDPEV D EN^APCDVD K APCDVSIT
MORE .;CONTINUE TO FIND MORE?
.W !! S DIR(0)="Y",DIR("A")="Continue to find more",DIR("B")="Y" KILL DA D ^DIR KILL DIR
.I $D(DIRUT) S APCDIWTQ=1 Q
.I 'Y S APCDIWTQ=1
Q
EOJ ;
D EN^XBVK("APCD")
Q
APCDDDPE ; IHS/CMI/LAB - delete dupe pt ed
+1 ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
+2 ;; ;
+3 WRITE !!,"Looking for visits with Duplicate Patient Education Topics"
+4 WRITE !!,"Please enter a starting visit date to look for visits with duplicate"
+5 WRITE !,"V Patient Education entries. The issue with duplicate education "
+6 WRITE !,"started sometime in 2015 so you might want to start with 01/01/2015.",!!
+7 KILL APCDPESD
+8 SET DIR(0)="D^:DT:EP"
SET DIR("A")="Enter starting visit date for search"
KILL DA
DO ^DIR
KILL DIR
+9 IF $DATA(DIRUT)
DO EOJ
QUIT
+10 SET APCDPESD=Y
+11 SET APCDPESD=$$FMADD^XLFDT(APCDPESD,-1)_".9999"
+12 SET APCDPEV=0
SET APCDC=0
+13 SET APCDMAX=0
SET APCDTOT=0
+14 KILL APCDIWTQ
+15 ;GET STARTING DATE
+16 FOR
SET APCDPESD=$ORDER(^AUPNVSIT("B",APCDPESD))
IF APCDPESD=""!($GET(APCDIWTQ))
QUIT
DO CHK
+17 QUIT
CHK ;
+1 SET APCDPEV=0
FOR
SET APCDPEV=$ORDER(^AUPNVSIT("B",APCDPESD,APCDPEV))
IF APCDPEV'=+APCDPEV!($GET(APCDIWTQ))
QUIT
Begin DoDot:1
+2 ;no patient ed
IF '$DATA(^AUPNVPED("AD",APCDPEV))
QUIT
+3 ;bad xref
IF '$DATA(^AUPNVSIT(APCDPEV,0))
QUIT
+4 ;no hospital
IF $PIECE(^AUPNVSIT(APCDPEV,0),U,7)="H"
QUIT
+5 IF $PIECE(^AUPNVSIT(APCDPEV,0),U,7)="I"
QUIT
+6 SET APCDX=0
SET APCDC=0
SET APCDZU=0
+7 KILL APCDZPED,APCDZDUP
+8 FOR
SET APCDX=$ORDER(^AUPNVPED("AD",APCDPEV,APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:2
+9 ;INTERNAL OF TOPIC
SET Y=$$VALI^XBDIQ1(9000010.16,APCDX,.01)
+10 ;INTERNAL OF EDUCATION PROVIDER
SET P=$$VALI^XBDIQ1(9000010.16,APCDX,.05)
+11 ;INTERNAL OF ENCOUNTER PROVIDER
IF 'P
SET P=$$VALI^XBDIQ1(9000010.16,APCDX,1204)
+12 ;no provider, not created by EHR so skip it
IF 'P
QUIT
+13 IF $DATA(APCDZPED(Y,P))
SET APCDZDUP(APCDX)="IEN: "_APCDX_U_$$VAL^XBDIQ1(9000010.16,APCDX,.01)_U_Y_$$VAL^XBDIQ1(9000010.16,APCDX,1204)_U_P
SET $PIECE(APCDZPED(Y,P),U,10)=$PIECE(APCDZPED(Y,P),U,10)+1
QUIT
+14 SET APCDZU=APCDZU+1
SET APCDZPED(Y,P)="IEN: "_APCDX_" "_$$VAL^XBDIQ1(9000010.16,APCDX,.01)_" "_$$VAL^XBDIQ1(9000010.16,APCDX,1204)
QUIT
End DoDot:2
+15 ;NO DUPES
IF '$DATA(APCDZDUP)
QUIT
+16 WRITE !!,$$FMTE^XLFDT($$VD^APCLV(APCDPEV))," HRN: ",$$HRN^AUPNPAT($PIECE(^AUPNVSIT(APCDPEV,0),U,5),DUZ(2))," ",$$CLINIC^APCLV(APCDPEV,"E")," ",$$PRIMPROV^APCLV(APCDPEV,"N")
+17 WRITE !,"There are ",APCDZU," unique topic/provider codes on this visit:"
+18 SET X=0
FOR
SET X=$ORDER(APCDZPED(X))
IF X'=+X
QUIT
SET P=0
FOR
SET P=$ORDER(APCDZPED(X,P))
IF P'=+P
QUIT
Begin DoDot:2
+19 WRITE !,$PIECE(APCDZPED(X,P),U,1)," (# of duplicates: "_+$PIECE(APCDZPED(X,P),U,10)_")"
+20 QUIT
End DoDot:2
+21 SET DIR(0)="Y"
SET DIR("A")="Would you like to display the visit"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+22 IF $DATA(DIRUT)
KILL APCDZPED,APCDZDUP
GOTO DEL
+23 IF Y
SET APCDVSIT=APCDPEV
DO EN^APCDVD
KILL APCDVSIT
DEL ;
+1 WRITE !!
KILL DIR
SET DIR(0)="Y"
SET DIR("A")="Would you like to delete the duplicates"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
GOTO MORE
+3 IF 'Y
GOTO MORE
+4 ;
+5 SET APCDX=0
FOR
SET APCDX=$ORDER(APCDZDUP(APCDX))
IF APCDX'=+APCDX
QUIT
Begin DoDot:2
+6 ;set log
+7 MERGE ^APCDVPED(APCDX)=^AUPNVPED(APCDX)
+8 SET DA=APCDX
SET DIK="^APCDVPED("
DO IX^DIK
KILL DIK,DA
+9 ;delete v patient ed
SET DA=APCDX
SET DIK="^AUPNVPED("
DO ^DIK
KILL DA,DIK
End DoDot:2
+10 SET DIR(0)="Y"
SET DIR("A")="Deletion complete, would you like to re-display the visit"
SET DIR("B")="N"
KILL DA
DO ^DIR
KILL DIR
+11 IF $DATA(DIRUT)
GOTO MORE
+12 IF 'Y
GOTO MORE
+13 SET APCDVSIT=APCDPEV
DO EN^APCDVD
KILL APCDVSIT
MORE ;CONTINUE TO FIND MORE?
+1 WRITE !!
SET DIR(0)="Y"
SET DIR("A")="Continue to find more"
SET DIR("B")="Y"
KILL DA
DO ^DIR
KILL DIR
+2 IF $DATA(DIRUT)
SET APCDIWTQ=1
QUIT
+3 IF 'Y
SET APCDIWTQ=1
End DoDot:1
+4 QUIT
EOJ ;
+1 DO EN^XBVK("APCD")
+2 QUIT
