- 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