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

BUDDRP6X.m

Go to the documentation of this file.
  1. BUDDRP6X ; IHS/CMI/LAB - measure C ;
  1. ;;11.0;IHS/RPMS UNIFORM DATA SYSTEM;;JAN 18, 2017;Build 66
  1. ;
  1. CNTDTAP ;
  1. NEW X,Y,C
  1. S (X,Y)="",C=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDDTAP(X) Q
  1. .S Y=X
  1. ;now count
  1. S BUDDTAP=0,X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S BUDDTAP=BUDDTAP+1
  1. Q
  1. RESETD ;RESET DUPES
  1. NEW X,Y,C
  1. S (X,Y)="",C=0 F S X=$O(BUDDT(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDDT(X) Q
  1. .S Y=X
  1. S (X,Y)="",C=0 F S X=$O(BUDDIP(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDDIP(X) Q
  1. .S Y=X
  1. S (X,Y)="",C=0 F S X=$O(BUDTET(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDTET(X) Q
  1. .S Y=X
  1. S (X,Y)="",C=0 F S X=$O(BUDTD(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDTD(X) Q
  1. .S Y=X
  1. S (X,Y)="",C=0 F S X=$O(BUDPER(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDPER(X) Q
  1. .S Y=X
  1. S BUDDT=0,X=0 F S X=$O(BUDDT(X)) Q:X'=+X S BUDDT=BUDDT+1
  1. S BUDTD=0,X=0 F S X=$O(BUDTD(X)) Q:X'=+X S BUDTD=BUDTD+1
  1. S BUDDIP=0,X=0 F S X=$O(BUDDIP(X)) Q:X'=+X S BUDDIP=BUDDIP+1
  1. S BUDTET=0,X=0 F S X=$O(BUDTET(X)) Q:X'=+X S BUDTET=BUDTET+1
  1. S BUDPER=0,X=0 F S X=$O(BUDPER(X)) Q:X'=+X S BUDPER=BUDPER+1
  1. Q
  1. DTAP(P,BDATE,EDATE) ;EP
  1. NEW BUDTET,BUDVS,TIEN,TIENDT,TIENTET,TIENDIP,TIENPER,CTR,VIEN,VDATE,X,Y,BUDX,BUDDT,BUDADT,BUDDIP,BUDPER,BUDDTAP,BUDPEREV,BUDEVTD,BUDEVIP,BUDCOTET,BUDCOPER,BUDCODIP,C,BUDG,BUDA,Z,G,A
  1. ;
  1. DTAPIM ;
  1. S BUDTET=0
  1. D ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS") ;all visits in 42 days to end
  1. S TIEN=$O(^BUDDTSSC("B","T6B IMM DTAP CODES",0))
  1. S TIENDT=$O(^BUDDTSSC("B","T6B IMM DT CODES",0))
  1. S TIENTET=$O(^BUDDTSSC("B","T6B IMM TETANUS CODES",0))
  1. S TIENDIP=$O(^BUDDTSSC("B","T6B IMM DIPHTHERIA CODES",0))
  1. S TIENPER=$O(^BUDDTSSC("B","T6B IMM PERTUSSIS CODES",0))
  1. S CTR=0 F S CTR=$O(BUDVS(CTR)) Q:CTR'=+CTR D
  1. .S VIEN=$P(BUDVS(CTR),U,5)
  1. .S VDATE=$P(BUDVS(CTR),U,1)
  1. .S X=0 F S X=$O(^AUPNVIMM("AD",VIEN,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVIMM(X,0))
  1. ..S Y=$$VALI^XBDIQ1(9000010.11,X,.01)
  1. ..S Y=+$P($G(^AUTTIMM(Y,0)),U,3)
  1. ..Q:'Y
  1. ..I $D(^BUDDTSSC(TIEN,15,"B",Y)) S BUDX(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC(TIENDT,15,"B",Y)) S BUDDT(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE),BUDADT(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC(TIENTET,15,"B",Y)) S BUDTET(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC(TIENDIP,15,"B",Y)) S BUDDIP(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC(TIENPER,15,"B",Y)) S BUDPER(VDATE)="CVX "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. .;CPT
  1. .S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVCPT(X,0))
  1. ..S Y=$$VAL^XBDIQ1(9000010.18,X,.01)
  1. ..Q:Y=""
  1. ..I $D(^BUDDTSSC("AC",Y,TIEN)) S BUDX(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENDT)) S BUDDT(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE),BUDADT(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENTET)) S BUDTET(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENDIP)) S BUDDIP(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENPER)) S BUDPER(VDATE)="CPT "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. .;V TRANS
  1. .S X=0 F S X=$O(^AUPNVTC("AD",VIEN,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVTC(X,0))
  1. ..S Y=$$VAL^XBDIQ1(9000010.33,X,.07)
  1. ..Q:Y=""
  1. ..I $D(^BUDDTSSC("AC",Y,TIEN)) S BUDX(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENDT)) S BUDDT(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE),BUDADT(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENTET)) S BUDTET(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENDIP)) S BUDDIP(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AC",Y,TIENPER)) S BUDPER(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. .;V PROC
  1. .S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVPRC(X,0))
  1. ..S Y=$$VALI^XBDIQ1(9000010.08,X,.01)
  1. ..I $D(^BUDDTSSC("AP",Y,TIEN)) S BUDX(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AP",Y,TIENDT)) S BUDDT(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE),BUDADT(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AP",Y,TIENTET)) S BUDTET(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AP",Y,TIENDIP)) S BUDDIP(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AP",Y,TIENPER)) S BUDPER(VDATE)="PROC "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. .S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X D
  1. ..Q:'$D(^AUPNVPOV(X,0))
  1. ..S Y=$$VAL^XBDIQ1(9000010.07,X,1101)
  1. ..Q:Y=""
  1. ..I $D(^BUDDTSSC("AS",Y,TIEN)) S BUDX(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AS",Y,TIENDT)) S BUDDT(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE),BUDADT(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AS",Y,TIENTET)) S BUDTET(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AS",Y,TIENDIP)) S BUDDIP(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ..I $D(^BUDDTSSC("AS",Y,TIENPER)) S BUDPER(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDDUTL1(VDATE) Q
  1. ;go through and set into DTAP if 10 days apart
  1. S X=0 F S X=$O(BUDX(X)) Q:X'=+X S BUDDTAP(X)=BUDX(X)
  1. D CNTDTAP ;count to see if there are 4
  1. I BUDDTAP>3 S Y="1^DTap: total #: "_BUDDTAP,X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S Y=Y_" "_BUDDTAP(X)
  1. I BUDDTAP>3 Q Y
  1. S (BUDPEREV,BUDEVTD,BUDEVDIP,BUDCOTET,BUDCOPER,BUDCODIP)=""
  1. ;now check contra to DTap
  1. S Y=$$CONTDTAP(P,$$DOB^AUPNPAT(P),EDATE)
  1. I Y Q Y
  1. DT1 ;
  1. ;kill off any that are on the same day as the dtaps
  1. S (X,Y)="",C=0 F S X=$O(BUDDT(X)) Q:X'=+X I $D(BUDDTAP(X)) K BUDDT(X)
  1. S (X,Y)="",C=0 F S X=$O(BUDDT(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDDT(X) Q
  1. .S Y=X
  1. K BUDALL
  1. S BUDDT=0,X=0 F S X=$O(BUDDT(X)) Q:X'=+X S BUDDT=BUDDT+1,BUDALL(X)=BUDDT(X)
  1. S BUDDTAP=0,X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S BUDDTAP=BUDDTAP+1,BUDALL(X)=BUDDTAP(X)
  1. S (X,Y)="",C=0 F S X=$O(BUDALL(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDALL(X) Q
  1. .S Y=X
  1. S BUDALL=0 S X=0 F S X=$O(BUDALL(X)) Q:X'=+X S BUDALL=BUDALL+1
  1. I BUDALL>3 D Q "1^"_Y
  1. .S Y=">=1 DTap & DT/TdS",X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S Y=Y_" "_BUDDTAP(X)
  1. .S X=0 F S X=$O(BUDDT(X)) Q:X'=+X S Y=Y_" "_BUDDT(X)
  1. ;
  1. TETCVX ;
  1. S BUDTET=0
  1. ;EVIDENCE?
  1. S BUDEVTD=""
  1. K BUDG S %=P_"^LAST DX 037.;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. I $D(BUDG(1)) S BUDEVTD="1^Tetanus Evidence: "_$P(BUDG(1),U,2)_" on "_$$DATE^BUDDUTL1($P(BUDG(1),U))
  1. K BUDG S %=P_"^LAST DX A35.;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. I $D(BUDG(1)) S BUDEVTD="1^Tetanus Evidence: "_$P(BUDG(1),U,2)_" on "_$$DATE^BUDDUTL1($P(BUDG(1),U))
  1. I $$PLCODE^BUDDDU(P,"037.",EDATE) S BUDEVTD="1^Tetanus Evidence: 037. on Problem List"
  1. I $$PLCODE^BUDDDU(P,"A35.",EDATE) S BUDEVTD="1^Tetanus Evidence: A35. on Problem List"
  1. S X=0 F S X=$O(BUDDT(X)) Q:X'=+X S BUDTET(X)=BUDDT(X)
  1. S X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S BUDTET(X)=BUDDTAP(X)
  1. S (X,Y)="",C=0 F S X=$O(BUDTET(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDTET(X) Q
  1. .S Y=X
  1. S X=0 F S X=$O(BUDTET(X)) Q:X'=+X S BUDTET=BUDTET+1
  1. DIP ;
  1. S BUDEVDIP=""
  1. ;V10.0 ICD10
  1. K BUDG S %=P_"^ALL DX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. S T=$O(^BUDDTSSC("B","T6B IMM EVIDENCE DIPHTHERIA",0))
  1. S X=0,BUDEVDIP="" F S X=$O(BUDG(X)) Q:X'=+X!(BUDEVDIP]"") D
  1. .S Y=+$P(BUDG(X),U,4)
  1. .S Y=$P($G(^AUPNVPOV(Y,0)),U,1)
  1. .I $D(^BUDDTSSC("AD",Y,T)) S BUDEVDIP="1^Diphtheria Evidence "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. S X=$$PLCL^BUDDDU(P,"T6B IMM EVIDENCE DIPHTHERIA",EDATE,0) I X S BUDEVDIP="1^Diphtheria Evidence: "_$P(X,U,2)_" on Problem List"
  1. S X=0 F S X=$O(BUDDT(X)) Q:X'=+X S BUDDIP(X)=BUDDT(X)
  1. S X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S BUDDIP(X)=BUDDTAP(X)
  1. S (X,Y)="",C=0 F S X=$O(BUDDIP(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDDIP(X) Q
  1. .S Y=X
  1. S X=0,BUDDIP=0 F S X=$O(BUDDIP(X)) Q:X'=+X S BUDDIP=BUDDIP+1
  1. ;
  1. PER ;
  1. S BUDPEREV=""
  1. ;V10.0 ICD10
  1. K BUDG S %=P_"^ALL DX;DURING "_BDATE_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. S T=$O(^BUDDTSSC("B","T6B IMM EVIDENCE PERTUSSIS",0))
  1. S X=0,BUDPEREV="" F S X=$O(BUDG(X)) Q:X'=+X!(BUDPEREV]"") D
  1. .S Y=+$P(BUDG(X),U,4)
  1. .S Y=$P($G(^AUPNVPOV(Y,0)),U,1)
  1. .I $D(^BUDDTSSC("AD",Y,T)) S BUDPEREV="1^Pertussis: Evidence "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. S X=$$PLCL^BUDDDU(P,"T6B IMM EVIDENCE PERTUSSIS",EDATE,0) I X S BUDPEREV="1^Pertussis: Evidence "_$P(X,U,2)_" on Problem List"
  1. S X=0 F S X=$O(BUDDTAP(X)) Q:X'=+X S BUDPER(X)=BUDDTAP(X)
  1. S (X,Y)="",C=0 F S X=$O(BUDPER(X)) Q:X'=+X S C=C+1 D
  1. .I C=1 S Y=X Q
  1. .I $$FMDIFF^XLFDT(X,Y)<11 K BUDPER(X) Q
  1. .S Y=X
  1. S X=0,BUDPER=0 F S X=$O(BUDPER(X)) Q:X'=+X S BUDPER=BUDPER+1
  1. I BUDPER<4,'BUDPEREV S BUDCOPER=$$CONTRA^BUDDRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDDTSSC("B","T6B IMM PERTUSSIS CODES",0)),"PERTUSSIS")
  1. I BUDDIP<4,'BUDEVDIP S BUDCODEP=$$CONTRA^BUDDRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDDTSSC("B","T6B IMM DIPHTHERIA CODES",0)),"DIPHTHERIA")
  1. I BUDTET<4,'BUDEVTD S BUDCOTET=$$CONTRA^BUDDRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDDTSSC("B","T6B IMM TETANUS CODES",0)),"TETANUS")
  1. CHK ;4 of each or evidence
  1. S BUDA(1)=$P(BUDEVDIP,U)_U_"DIP: Evidence"_U_$P(BUDEVDIP,U,2)
  1. S X=0,Y="" F S X=$O(BUDDIP(X)) Q:X'=+X S Y=Y_" "_BUDDIP(X)
  1. S BUDA(2)=$S(BUDDIP>3:1,1:0)_U_"DIP: total #: 4"_U_Y
  1. S BUDA(3)=$P(BUDCODIP,U)_U_"DIP: CONTRA"_U_$P(BUDCODIP,U,2)
  1. ;
  1. S BUDA(4)=$P(BUDEVTD,U)_U_"Tetanus: Evidence"_U_$P(BUDEVTD,U,2)
  1. S X=0,Y="" F S X=$O(BUDETT(X)) Q:X'=+X S Y=Y_" "_BUDTET(X)
  1. S BUDA(5)=$S(BUDTET>3:1,1:0)_U_"Tetanus: total #: 4"_U_Y
  1. S BUDA(6)=$P(BUDCOTET,U)_U_"Tetanus: CONTRA"_U_$P(BUDCOTET,U,2)
  1. ;
  1. S BUDA(7)=$P(BUDPEREV,U)_U_"Perussis: Evidence"_U_$P(BUDPEREV,U,2)
  1. S X=0,Y="" F S X=$O(BUDPER(X)) Q:X'=+X S Y=Y_" "_BUDPER(X)
  1. S BUDA(8)=$S(BUDPER>3:1,1:0)_U_"Pertussis: total #: 4"_U_Y
  1. S BUDA(9)=$P(BUDCOPER,U)_U_"Pertussis: CONTRA"_U_$P(BUDCOPER,U,2)
  1. ;
  1. S G=""
  1. F X=1,2,3 D Q:G]""
  1. .F Y=4,5,6 D Q:G]""
  1. ..F Z=7,8,9 D Q:G]""
  1. ...I $P(BUDA(X),U,1),$P(BUDA(Y),U,1),$P(BUDA(Z),U,1) D
  1. ....S G=1_U_$P(BUDA(X),U,2)_", "_$P(BUDA(Y),U,2)_", "_$P(BUDA(Z),U,2)
  1. ....S A="",A=$P(BUDA(X),U,3)_", "_$P(BUDA(Y),U,3)_", "_$P(BUDA(Z),U,3)
  1. ....S G=G_" "_A
  1. I G]"" Q G
  1. S Y="0^"
  1. I BUDDIP<4,'BUDEVDIP S Y=Y_(4-BUDDIP)_" DIP "
  1. I BUDTET<4,'BUDEVTD S Y=Y_(4-BUDTET)_" TET "
  1. I BUDPER<4,'BUDPEREV S Y=Y_(4-BUDPER)_" PER"
  1. Q Y
  1. CONTDTAP(P,BDATE,EDATE) ;
  1. NEW BUDG,X,G,Z,E,%,T,S,BUDZ
  1. ;first check for contraindication
  1. K BUDG S %=P_"^ALL DX 323.5;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. I '$D(BUDG(1)) G N
  1. S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") S Y=+$P(BUDG(X),U,4) D
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.09) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.18) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.19) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. I G]"" Q G
  1. N K BUDG S %=P_"^ALL DX 323.51;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. I '$D(BUDG(1)) G N1
  1. S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") S Y=+$P(BUDG(X),U,4) D
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.09) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.18) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.19) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. I G]"" Q G
  1. N1 K BUDG S %=P_"^ALL DX 323.52;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") S Y=+$P(BUDG(X),U,4) D
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.09) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.18) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. .S Z=$$VAL^XBDIQ1(9000010.07,Y,.19) I Z="E948.4"!(Z="E948.5")!(Z="E948.6") S G="1^DTAP: CONTRA DX/Ecode: "_$P(BUDG(X),U,2)_"/"_Z_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U))
  1. I G]"" Q G
  1. N2 ;V10.0 ICD10
  1. K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
  1. S T=$O(^BUDDTSSC("B","T6B IMM CONTRA DTAP/DTP",0))
  1. S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
  1. .S Y=+$P(BUDG(X),U,4)
  1. .S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
  1. .I $D(^BUDDTSSC("AD",Z,T)) S G="1^DTAP: CONTRA DX "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U)) Q
  1. .S S=$$VALI^XBDIQ1(9000010.07,Y,1101)
  1. .I S]"",$D(^BUDDTSSC(T,13,"B",S)) S G="1^DTAP: CONTRA DX/SNOMED "_S_" on "_$$DATE^BUDDUTL1($P(BUDG(X),U)) Q
  1. K BUDG
  1. I G]"" Q G
  1. S BUDZ=0,X=""
  1. F S BUDZ=$O(^BUDDTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$ANCONT^BUDDRP6C(P,BUDZ,EDATE)
  1. I X]"" Q "1^DTAP: CONTRA IMM package: "_$$DATE^BUDDUTL1($P(X,U))_" "_$P(X,U,2)
  1. S X=$$CONTRA^BUDDRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDDTSSC("B","T6B IMM CONTRA DTAP/DTP",0)),"DTAP")
  1. I X Q X
  1. S X=$$PLCL^BUDDDU(P,"T6B IMM CONTRA DTAP/DTP",EDATE,0) I X Q "1^DTAP: CONTRA "_$P(X,U,2)_" on Problem List"
  1. Q ""