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

ATXPOV.m

Go to the documentation of this file. 
  1. ATXPOV ; IHS/OHPRD/TMJ -  IF ICD CODE HAS A TAXON, ENTER PAT IN PT TAX FILE ; 07 Feb 2016  5:51 PM
  1.  ;;5.1;TAXONOMY;**11,14,15**;FEB 04, 1997;Build 20
  1.  ;IHS/TUCSON/LAB - because of the check for the variable
  1.  ;IHS/CMI/LAB - patch 1 to version 5.1 allows the autoupdating
  1.  ;of complications in a CMS register triggered from PCC Data Entry
  1.  ;6/20/2000
  1.  ;APCDDATE at the top of this routine, bulletins were not being
  1.  ;sent if the user was not using PCC Data Entry.  This has been
  1.  ;changed so that bulletins will be fired even if the POV is
  1.  ;created by a link from another package.
  1.  ;Q:'$D(APCDDATE)!('$D(DA))!('$D(X))
  1.  Q:'$D(DA)!('$D(X))  ;DA IS DA OF aupnvpov, X is internal of ICD code
  1.  NEW ATXPOVDA,ATXDI,ATXICD
  1.  ;ATXVISI visit ien
  1.  ;ATXVIS visit date
  1.  ;ATXDFN patient dfn
  1.  ;ATXPOVDA V POV ien
  1.  ;kill side of xref, .03 exists
  1.  S ATXPOVDA=DA
  1.  S ATXDI=X   ;ien of icd code
  1.  ;I $P(^AUPNVPOV(ATXPOVDA,0),U,3) S ATXVISI=$P(^AUPNVPOV(ATXPOVDA,0),U,3),ATXVIS=$$VD^APCLV(ATXVISI),ATXDFN=$P(^AUPNVPOV(ATXPOVDA,0),U,2)
  1.  ;I '$D(ATXAD),$P(^AUPNVPOV(DA,0),U,3) S ATXVIS=+^AUPNVSIT($P(^AUPNVPOV(DA,0),U,3),0) S:'$D(APCDVSIT) APCDVSIT=$P(^AUPNVPOV(DA,0),U,3) S:'$D(AUPNPAT) AUPNPAT=$P(^AUPNVPOV(DA,0),U,2)
  1.  ;E  S ATXVIS=$P(APCDDATE,".")
  1.  ;Set ATXVIS with visit Date
  1.  ;E  S ATXVIS=$S($G(APCDDATE):$P(APCDDATE,"."),$G(APCDVSIT):$P($P(^AUPNVSIT(APCDVSIT,0),U),"."),1:"")
  1.  ;Q:ATXVIS=""
  1.  ;
  1.  ;I '$O(^ICD9(ATXDI,9999999.41,0)) D CMSCMPL,EOJ Q  ;IHS/CMI/LAB
  1.  ;NEW FOR AICD 4.0
  1.  ;loop "ABLT" and call ICD^ATXCHK with X
  1.  NEW T,B,G,F
  1.  S (B,G)=0 F  S B=$O(^ATXAX("ABLT",B)) Q:B'=+B!(G)  D
  1.  .S T=0 F  S T=$O(^ATXAX("ABLT",B,T)) Q:T'=+T!(G)  D
  1.  ..Q:'$D(^ATXAX(T,0))
  1.  ..I $P(^ATXAX(T,0),U,15)'=80 Q
  1.  ..I $$ICD^ATXCHK(ATXDI,T,9) S G=1
  1.  .Q
  1.  I 'G D CMSCMPL Q
  1.  I '$D(ATXAD) D CMSCMPL Q  ;IF NOT IN SET SIDE THEN JUST DO COMPLICATIONS  ***LORI
  1.  ;
  1.  D START
  1.  D EOJ
  1.  Q
  1.  ;
  1.  ;
  1. CALL ;SEE IF PT TAX FILE TO BE UPDATED
  1.  Q:'$D(^ATXPAT(ATXDT,0))#2
  1.  I ATXVIS<$P(^ATXAX(ATXDT,0),U,6) Q
  1.  I $D(ATXAD) D DIEADD^ATXPAT Q
  1.  I '$D(ATXAD) D DIEDEL^ATXPAT Q
  1.  Q
  1.  ;
  1. START ;
  1.  ;
  1.  NEW ZTRTN,ZTSAVE,ZTDESC,ZTIO,ZTDTH,ZTSK,%
  1.  S ATXICD=ATXDI
  1.  F %="ATXPOVDA","ATXICD","ATXDI" S ZTSAVE(%)=""
  1.  S ZTRTN="START1^ATXPOV"
  1.  S ZTDESC="BULLETIN/COMPL TRIGGER FROM PCC DATA ENTRY"
  1.  S ZTIO=""
  1.  S ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+300  ;CHANGE TO 300
  1.  D ^%ZTLOAD
  1.  K ZTSK
  1. X Q
  1.  ;
  1. START1 ;EP = called from taskman
  1.  ;call bulletin for any taxonomies that have this code
  1.  S ATXDT=""
  1.  S ATXB=0 F  S ATXB=$O(^ATXAX("ABLT",ATXB)) Q:ATXB'=+ATXB  D
  1.  .S ATXT=0 F  S ATXT=$O(^ATXAX("ABLT",ATXB,ATXT)) Q:ATXT'=+ATXT  D
  1.  ..S ATXDT="" I $$ICD^ATXCHK(ATXDI,ATXT,9) S ATXDT=ATXT D EN^ATXBULL
  1.  .Q
  1.  D CMSCMPL0
  1.  I $D(ZTQUEUED) S ZTREQ="@"
  1. EOJ ;
  1.  K ATXDT,ATXL,ATXPD,ATXDI,ATXAD,ATXVIS,ATXDOLH,ATXPOVDA,ATXVISDA,ATXC,ATXR,ATXRCMS,ATXR1
  1.  Q
  1.  ;
  1. CMSCMPL ;
  1.  ;if this ICD code is in ^ACM(42.1,"DX", xref
  1.  ;then get registers associated with it
  1.  ;if this patient is on any of those registers, then update
  1.  ;their complication list if this isn't already on their list
  1.  ;S ATXDT=0,ATXPD=AUPNPAT
  1.  ;maybe this should be tasked to the background ??
  1.  Q:ATXDI=""
  1.  Q:'$D(^ACM(42.1,"DX",ATXDI))  ;IHS/CMI/LAB - not in any complication list so don't bother
  1.  ;task off to taskman
  1.  ;G CMSCMPL0  ;LORI REMOVE
  1.  NEW ZTRTN,ZTDESC,ZTIO,ZTDTH,ZTSK,%
  1.  F %="ATXDI","ATXPOVDA" S ZTSAVE(%)=""
  1.  S ZTRTN="CMSCMPL0^ATXPOV"
  1.  S ZTDESC="CMS COMPL TRIGGER FROM PCC DATA ENTRY"
  1.  S ZTIO=""
  1.  S ZTDTH=$H,$P(ZTDTH,",",2)=$P(ZTDTH,",",2)+300
  1.  D ^%ZTLOAD
  1.  K ZTSK
  1.  Q
  1. CMSCMPL0 ;EP - called from taskman
  1.  ;SET UP VARS
  1.  Q:ATXDI=""
  1.  Q:'$D(^ACM(42.1,"DX",ATXDI))  ;IHS/CMI/LAB - not in any complication list so don't bother
  1.  NEW ATXC,ATXR,ATXRA,ATXPD
  1.  S ATXPD=$P($G(^AUPNVPOV(ATXPOVDA,0)),U,2)  ;patient
  1.  Q:'ATXPD  ;v pov must have been deleted
  1.  S ATXC=0 F  S ATXC=$O(^ACM(42.1,"DX",ATXDI,ATXC)) Q:ATXC'=+ATXC  D
  1.  .;process each complication
  1.  .S ATXR1=0 F  S ATXR1=$O(^ACM(42.1,ATXC,"RG",ATXR1)) Q:ATXR1'=+ATXR1  D
  1.  ..;process each register
  1.  ..S ATXR=$P(^ACM(42.1,ATXC,"RG",ATXR1,0),U,1)
  1.  ..Q:'$D(^ACM(41,"AC",ATXPD,ATXR))  ;patient not on this register
  1.  ..S ATXRCMS=^ACM(41,"AC",ATXPD,ATXR)
  1.  ..;update complication for this patient
  1.  ..Q:$D(^ACM(42,"AC",ATXR,ATXPD,ATXC))  ;pt already has this complication
  1.  ..;add complication to file
  1.  ..S DIADD=1,DLAYGO=9002242,X=ATXC,DIC="^ACM(42,",DIC("DR")=".02////"_ATXPD_";.03////"_ATXRCMS_";.04////"_ATXR,DIC(0)="L" K DD,D0,DO D FILE^DICN
  1.  ..K DIC,DIADD,DLAYGO
  1.  Q