Home   Package List   Routine Alphabetical List   Global Alphabetical List   FileMan Files List   FileMan Sub-Files List   Package Component Lists   Package-Namespace Mapping  
Routine: APCDDDPE

APCDDDPE.m

Go to the documentation of this file.
  1. APCDDDPE ; IHS/CMI/LAB - delete dupe pt ed
  1. ;;2.0;IHS PCC SUITE;**20**;MAY 14, 2009;Build 25
  1. ;; ;
  1. W !!,"Looking for visits with Duplicate Patient Education Topics"
  1. W !!,"Please enter a starting visit date to look for visits with duplicate"
  1. W !,"V Patient Education entries. The issue with duplicate education "
  1. W !,"started sometime in 2015 so you might want to start with 01/01/2015.",!!
  1. K APCDPESD
  1. S DIR(0)="D^:DT:EP",DIR("A")="Enter starting visit date for search" KILL DA D ^DIR KILL DIR
  1. I $D(DIRUT) D EOJ Q
  1. S APCDPESD=Y
  1. S APCDPESD=$$FMADD^XLFDT(APCDPESD,-1)_".9999"
  1. S APCDPEV=0,APCDC=0
  1. S APCDMAX=0,APCDTOT=0
  1. K APCDIWTQ
  1. ;GET STARTING DATE
  1. F S APCDPESD=$O(^AUPNVSIT("B",APCDPESD)) Q:APCDPESD=""!($G(APCDIWTQ)) D CHK
  1. Q
  1. CHK ;
  1. S APCDPEV=0 F S APCDPEV=$O(^AUPNVSIT("B",APCDPESD,APCDPEV)) Q:APCDPEV'=+APCDPEV!($G(APCDIWTQ)) D
  1. .Q:'$D(^AUPNVPED("AD",APCDPEV)) ;no patient ed
  1. .Q:'$D(^AUPNVSIT(APCDPEV,0)) ;bad xref
  1. .Q:$P(^AUPNVSIT(APCDPEV,0),U,7)="H" ;no hospital
  1. .Q:$P(^AUPNVSIT(APCDPEV,0),U,7)="I"
  1. .S APCDX=0,APCDC=0,APCDZU=0
  1. .K APCDZPED,APCDZDUP
  1. .F S APCDX=$O(^AUPNVPED("AD",APCDPEV,APCDX)) Q:APCDX'=+APCDX D
  1. ..S Y=$$VALI^XBDIQ1(9000010.16,APCDX,.01) ;INTERNAL OF TOPIC
  1. ..S P=$$VALI^XBDIQ1(9000010.16,APCDX,.05) ;INTERNAL OF EDUCATION PROVIDER
  1. ..I 'P S P=$$VALI^XBDIQ1(9000010.16,APCDX,1204) ;INTERNAL OF ENCOUNTER PROVIDER
  1. ..I 'P Q ;no provider, not created by EHR so skip it
  1. ..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
  1. ..S APCDZU=APCDZU+1,APCDZPED(Y,P)="IEN: "_APCDX_" "_$$VAL^XBDIQ1(9000010.16,APCDX,.01)_" "_$$VAL^XBDIQ1(9000010.16,APCDX,1204) Q
  1. .I '$D(APCDZDUP) Q ;NO DUPES
  1. .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")
  1. .W !,"There are ",APCDZU," unique topic/provider codes on this visit:"
  1. .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
  1. ..W !,$P(APCDZPED(X,P),U,1)," (# of duplicates: "_+$P(APCDZPED(X,P),U,10)_")"
  1. ..Q
  1. .S DIR(0)="Y",DIR("A")="Would you like to display the visit",DIR("B")="N" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) K APCDZPED,APCDZDUP G DEL
  1. .I Y S APCDVSIT=APCDPEV D EN^APCDVD K APCDVSIT
  1. DEL .;
  1. .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
  1. .I $D(DIRUT) G MORE
  1. .I 'Y G MORE
  1. .;
  1. .S APCDX=0 F S APCDX=$O(APCDZDUP(APCDX)) Q:APCDX'=+APCDX D
  1. ..;set log
  1. ..M ^APCDVPED(APCDX)=^AUPNVPED(APCDX)
  1. ..S DA=APCDX,DIK="^APCDVPED(" D IX^DIK K DIK,DA
  1. ..S DA=APCDX,DIK="^AUPNVPED(" D ^DIK K DA,DIK ;delete v patient ed
  1. .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
  1. .I $D(DIRUT) G MORE
  1. .I 'Y G MORE
  1. .S APCDVSIT=APCDPEV D EN^APCDVD K APCDVSIT
  1. MORE .;CONTINUE TO FIND MORE?
  1. .W !! S DIR(0)="Y",DIR("A")="Continue to find more",DIR("B")="Y" KILL DA D ^DIR KILL DIR
  1. .I $D(DIRUT) S APCDIWTQ=1 Q
  1. .I 'Y S APCDIWTQ=1
  1. Q
  1. EOJ ;
  1. D EN^XBVK("APCD")
  1. Q