BUDHRP6H ;IHS/CMI/LAB - UDS REPORT PROCESS;
;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
;
;
HEPA(P,BDATE,EDATE) ;EP
;first check for contraindications
HEPAC ;
NEW T,X,BUDZ,BUDG,%,E,G,Y,Z,BUDHEPA,BUDVS,TIEN,CTR,VIEN,VDATE
S T=$O(^BUDHTSSC("B","T6B IMM CONTRA HEP A",0)),X=""
S BUDZ=0 F S BUDZ=$O(^BUDHTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
I X]"" Q "1^HEP A: CONTRA IMM package "_$$DATE^BUDHUTL1($P(X,U))_" "_$P(X,U,2)
K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
S T=$O(^BUDHTSSC("B","T6B IMM CONTRA HEP A",0))
S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
.S Y=+$P(BUDG(X),U,4)
.S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
.I $D(^BUDHTSSC("AD",Z,T)) S G="1^HEP A: CONTRA DX "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
.S S=$$VAL^XBDIQ1(9000010.07,Y,1101) I S]"",$D(^BUDHTSSC("AS",S,T)) S G="1^HEP A: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
I G]"" Q G
S X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA HEP A",EDATE,0) I X Q "1^HEP A CONTRA DX: "_$P(X,U,2)_" on Problem List"
S X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDHTSSC("B","T6B IMM HEP A CODES",0)),"HEP A")
I X]"" Q X
HEPAEVID ;
;any evidence of HEPA?
K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
S T=$O(^BUDHTSSC("B","T6B IMM EVIDENCE HEP A",0))
S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
.S Y=+$P(BUDG(X),U,4)
.S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
.I $D(^BUDHTSSC("AD",Z,T)) S G="1^HEP A: Evidence "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U)) Q
.S S=$$VAL^XBDIQ1(9000010.07,Y,.01) I S]"",$D(^BUDHTSSC("AS",S,T)) S G="1^HEP A: Evidence "_S_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
I G]"" Q G
S X=$$PLCL^BUDHDU(P,"T6B IMM EVIDENCE HEP A",EDATE,0) I X Q "1^HEP A: Evidence: "_$P(X,U,2)_" on Problem List"
HEPAI ;
S BUDHEPA=""
D ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS") ;all visits in 42 days to end
S TIEN=$O(^BUDHTSSC("B","T6B IMM HEP A CODES",0))
S CTR=0 F S CTR=$O(BUDVS(CTR)) Q:CTR'=+CTR D
.S VIEN=$P(BUDVS(CTR),U,5)
.S VDATE=$P(BUDVS(CTR),U,1)
.S X=0 F S X=$O(^AUPNVIMM("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVIMM(X,0))
..S Y=$$VALI^XBDIQ1(9000010.11,X,.01)
..S Y=+$P($G(^AUTTIMM(Y,0)),U,3)
..Q:'Y
..I $D(^BUDHTSSC(TIEN,15,"B",Y)) S BUDHEPA="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;CPT
.S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVCPT(X,0))
..S Y=$$VAL^XBDIQ1(9000010.18,X,.01)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN)) S BUDHEPA="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V TRANS
.S X=0 F S X=$O(^AUPNVTC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVTC(X,0))
..S Y=$$VAL^XBDIQ1(9000010.33,X,.07)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN)) S BUDHEPA="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V PROC
.S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPRC(X,0))
..S Y=$$VALI^XBDIQ1(9000010.08,X,.01)
..I $D(^BUDHTSSC("AP",Y,TIEN)) S BUDHEPA="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPOV(X,0))
..S Y=$$VAL^XBDIQ1(9000010.07,X,1101)
..Q:Y=""
..I $D(^BUDHTSSC("AS",Y,TIEN)) S BUDHEPA="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
I BUDHEPA]"" Q "1^HEP A: "_BUDHEPA
;
Q "0^1 HEP A"
;
FLU(P,BDATE,EDATE) ;EP
NEW BUDD,BUDG,BUDX,T,X,Y,Z,BUDZ,G,S,BUDFLU,BUDVS,TIEN,CTR,VIEN,VDATE,C
S T=$O(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0)),X=""
S BUDZ=0 F S BUDZ=$O(^BUDHTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$ROTACONT^BUDHRP6W(P,BUDZ,EDATE)
I X]"" Q "1^Influenza: CONTRA IMM package "_$$DATE^BUDHUTL1($P(X,U))_" "_$P(X,U,2)
S BUDZ=0 F S BUDZ=$O(^BUDHTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$EGGCONT^BUDHRP6C(P,BUDZ,EDATE)
I X]"" Q "1^Influenza: CONTRA IMM package "_$$DATE^BUDHUTL1($P(X,U))_" "_$P(X,U,2)
S T=$O(^BUDHTSSC("B","T6B IMM CONTRA INFLUENZA",0))
K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
.S Y=+$P(BUDG(X),U,4)
.S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
.I $D(^BUDHTSSC("AD",Z,T)) S G="1^Influenza: CONTRA DX "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
.S S=$$VAL^XBDIQ1(9000010.07,Y,1101) I S]"",$D(^BUDHTSSC("AS",S,T)) S G="1^Influenza: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
I G]"" Q G
S X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA INFLUENZA,EDATE,0") I X Q "1^Influenza: CONTRA DX "_$P(X,U,2)_" on Problem List"
S X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0)),"INFLUENZA")
I X]"" Q X
S X=$$DIS^BUDHUTL3(P,EDATE) I X Q 1_U_"FLU: CONTRA DIS IMMUNE SYS"
S X=$$HIV^BUDHUTL3(P,EDATE) I X Q 1_U_"FLU: CONTRA HIV"
S X=$$MNLHT^BUDHUTL3(P,EDATE) I X Q 1_U_"FLU: CONTRA NEOPLASM"
K BUDFLU
FLUIMM ;get all immunizations
S BUDFLU=0
D ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS") ;all visits in 42 days to end
S TIEN=$O(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0))
S CTR=0 F S CTR=$O(BUDVS(CTR)) Q:CTR'=+CTR D
.S VIEN=$P(BUDVS(CTR),U,5)
.S VDATE=$P(BUDVS(CTR),U,1)
.S X=0 F S X=$O(^AUPNVIMM("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVIMM(X,0))
..S Y=$$VALI^XBDIQ1(9000010.11,X,.01)
..S Y=+$P($G(^AUTTIMM(Y,0)),U,3)
..Q:'Y
..I $D(^BUDHTSSC(TIEN,15,"B",Y)) S BUDFLU(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;CPT
.S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVCPT(X,0))
..S Y=$$VAL^XBDIQ1(9000010.18,X,.01)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN)) S BUDFLU(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V TRANS
.S X=0 F S X=$O(^AUPNVTC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVTC(X,0))
..S Y=$$VAL^XBDIQ1(9000010.33,X,.07)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN)) S BUDFLU(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V PROC
.S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPRC(X,0))
..S Y=$$VALI^XBDIQ1(9000010.08,X,.01)
..I $D(^BUDHTSSC("AP",Y,TIEN)) S BUDFLU(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPOV(X,0))
..S Y=$$VAL^XBDIQ1(9000010.07,X,1101)
..Q:Y=""
..I $D(^BUDHTSSC("AS",Y,TIEN)) S BUDFLU(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
S (X,Y)="",C=0 F S X=$O(BUDFLU(X)) Q:X'=+X S C=C+1 D
.I C=1 S Y=X Q
.I $$FMDIFF^XLFDT(X,Y)<11 K BUDFLU(X) Q
.S Y=X
;now count them and see if there are 4 of them
S BUDFLU=0,X=0 F S X=$O(BUDFLU(X)) Q:X'=+X S BUDFLU=BUDFLU+1
I BUDFLU>1 S Y="1^Influenza: total #: "_BUDFLU,X="" F S X=$O(BUDFLU(X)) Q:X'=+X S Y=Y_" "_BUDFLU(X)
I BUDFLU>1 Q Y
S X=2-BUDFLU
Q "0^"_X_" Influenza"
;
ROTA(P,BDATE,EDATE) ;EP
NEW BUDD,BUDG,BUDX,T,BUDZ,X,Y,Z,G,%,E,BUDROT2,BUDROT3,BUDVS,TIEN2,TIEN3,CTR,VIEN,VDATE
K BUDD,BUDG,BUDX
S T=$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0)),X=""
S BUDZ=0 F S BUDZ=$O(^BUDHTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
I X]"" Q "1^Rotavirus: CONTRA IMM package "_$$DATE^BUDHUTL1($P(X,U))_" "_$P(X,U,2)
S T=$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0))
S BUDZ=0 F S BUDZ=$O(^BUDHTSSC(T,15,"B",BUDZ)) Q:BUDZ=""!(X]"") S X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
I X]"" Q "1^Rotavirus: CONTRA IMM package "_$$DATE^BUDHUTL1($P(X,U))_" "_$P(X,U,2)
K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
S T=$O(^BUDHTSSC("B","T6B IMM CONTRA ROTAVIRUS",0))
S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
.S Y=+$P(BUDG(X),U,4)
.S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
.I $D(^BUDHTSSC("AD",Z,T)) S G="1^Rotavirus: CONTRA DX "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
.S S=$$VAL^XBDIQ1(9000010.07,Y,1101) I S]"",$D(^BUDHTSSC("AS",S,T)) S G="1^Rotavirus: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
I G]"" Q G
S X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA ROTAVIRUS",EDATE,0) I X Q "1^Rotavirus: CONTRA DX "_$P(X,U,2)_" on Problem List"
S X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0)),"ROTAVIRUS 2")
I X]"" Q X
S X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0)),"ROTAVIRUS 3")
I X]"" Q X
S X=$$ANSNROTA^BUDHUTL3(P,EDATE) I X Q 1_U_"ROTA: CONTRA ANAPHYLACTIC REACTION"
S X=$$SCID^BUDHUTL3(P,EDATE) I X Q 1_U_"ROTA: CONTRA SCID"
S X=$$INTUSS^BUDHUTL3(P,EDATE) I X Q 1_U_"ROTA: CONTRA INTUSSUSCEPTION"
ROTAEVID ;
;any evidence of ROTA?
K BUDG S %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE,E=$$START1^APCLDF(%,"BUDG(")
S T=$O(^BUDHTSSC("B","T6B IMM EVIDENCE ROTAVIRUS",0))
S X=0,G="" F S X=$O(BUDG(X)) Q:X'=+X!(G]"") D
.S Y=+$P(BUDG(X),U,4)
.S Z=$P($G(^AUPNVPOV(Y,0)),U,1)
.I $D(^BUDHTSSC("AD",Z,T)) S G="1^Rotavirus: Evidence "_$P(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U)) Q
.S S=$$VAL^XBDIQ1(9000010.07,Y,.01) I S]"",$D(^BUDHTSSC("AS",S,T)) S G="1^Rotavirus: Evidence "_S_" on "_$$DATE^BUDHUTL1($P(BUDG(X),U))
I G]"" Q G
S X=$$PLCL^BUDHDU(P,"T6B IMM EVIDENCE ROTAVIRUS",EDATE,0) I X Q "1^Rotavirus: Evidence "_$P(X,U,2)_" on Problem List"
ROTAIMM ;
D ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS") ;all visits in 42 days to end
S TIEN2=$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0))
S TIEN3=$O(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0))
S CTR=0 F S CTR=$O(BUDVS(CTR)) Q:CTR'=+CTR D
.S VIEN=$P(BUDVS(CTR),U,5)
.S VDATE=$P(BUDVS(CTR),U,1)
.S X=0 F S X=$O(^AUPNVIMM("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVIMM(X,0))
..S Y=$$VALI^XBDIQ1(9000010.11,X,.01)
..S Y=+$P($G(^AUTTIMM(Y,0)),U,3)
..Q:'Y
..I $D(^BUDHTSSC(TIEN2,15,"B",Y)) S BUDROT2(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
..I $D(^BUDHTSSC(TIEN3,15,"B",Y)) S BUDROT3(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;CPT
.S X=0 F S X=$O(^AUPNVCPT("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVCPT(X,0))
..S Y=$$VAL^XBDIQ1(9000010.18,X,.01)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN2)) S BUDROT2(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
..I $D(^BUDHTSSC("AC",Y,TIEN3)) S BUDROT3(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V TRANS
.S X=0 F S X=$O(^AUPNVTC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVTC(X,0))
..S Y=$$VAL^XBDIQ1(9000010.33,X,.07)
..Q:Y=""
..I $D(^BUDHTSSC("AC",Y,TIEN2)) S BUDROT2(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
..I $D(^BUDHTSSC("AC",Y,TIEN3)) S BUDROT3(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V PROC
.S X=0 F S X=$O(^AUPNVPRC("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPRC(X,0))
..S Y=$$VALI^XBDIQ1(9000010.08,X,.01)
..I $D(^BUDHTSSC("AP",Y,TIEN2)) S BUDROT2(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
..I $D(^BUDHTSSC("AP",Y,TIEN3)) S BUDROT3(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
.;V SNOM
.S X=0 F S X=$O(^AUPNVPOV("AD",VIEN,X)) Q:X'=+X D
..Q:'$D(^AUPNVPOV(X,0))
..S Y=$$VAL^XBDIQ1(9000010.07,X,1101)
..Q:Y=""
..I $D(^BUDHTSSC("AS",Y,TIEN2)) S BUDROT2(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
..I $D(^BUDHTSSC("AS",Y,TIEN3)) S BUDROT3(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE) Q
;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
S (X,Y)="",C=0 F S X=$O(BUDROT2(X)) Q:X'=+X S C=C+1 D
.I C=1 S Y=X Q
.I $$FMDIFF^XLFDT(X,Y)<11 K BUDROT2(X) Q
.S Y=X
S (X,Y)="",C=0 F S X=$O(BUDROT3(X)) Q:X'=+X S C=C+1 D
.I C=1 S Y=X Q
.I $$FMDIFF^XLFDT(X,Y)<11 K BUDROT3(X) Q
.S Y=X
;now count them and see if there are 3 of them
S BUDROT2=0,X=0 F S X=$O(BUDROT2(X)) Q:X'=+X S BUDROT2=BUDROT2+1
I BUDROT2>1 S Y="1^Rotavirus 2 Dose: total #: "_BUDROT2,X="" F S X=$O(BUDROT2(X)) Q:X'=+X S Y=Y_" "_BUDROT2(X)
I BUDROT2>1 Q Y
S BUDROT3=0,X=0 F S X=$O(BUDROT3(X)) Q:X'=+X S BUDROT3=BUDROT3+1
I BUDROT3>2 S Y="1^Rotavirus 3 Dose: total #: "_BUDROT3,X="" F S X=$O(BUDROT3(X)) Q:X'=+X S Y=Y_" "_BUDROT3(X)
I BUDROT3>2 Q Y
;now see if has 3 total
K BUDROTA
S X=0 F S X=$O(BUDROT2(X)) Q:X'=+X S BUDROTA(X)=BUDROT2(X)
S X=0 F S X=$O(BUDROT3(X)) Q:X'=+X I '$D(BUDROTA(X)) S BUDROTA(X)=BUDROT3(X)
;see if 11 days apart
S (X,Y)="",C=0 F S X=$O(BUDROTA(X)) Q:X'=+X S C=C+1 D
.I C=1 S Y=X Q
.I $$FMDIFF^XLFDT(X,Y)<11 K BUDROTA(X) Q
.S Y=X
S BUDROTA=0,X=0 F S X=$O(BUDROTA(X)) Q:X'=+X S BUDROTA=BUDROTA+1
I BUDROTA>2 S Y="1^Rotavirus 3 Dose: total #: "_BUDROTA,X="" F S X=$O(BUDROTA(X)) Q:X'=+X S Y=Y_" "_BUDROTA(X)
I BUDROTA>2 Q Y
Q "0^"_(2-BUDROT2)_" 2 Dose Rotavirus or "_(3-BUDROT3)_" 3 Dose Rotavirus"
;
BUDHRP6H ;IHS/CMI/LAB - UDS REPORT PROCESS;
+1 ;;13.0;IHS/RPMS UNIFORM DATA SYSTEM;;OCT 12, 2018;Build 90
+2 ;
+3 ;
HEPA(P,BDATE,EDATE) ;EP
+1 ;first check for contraindications
HEPAC ;
+1 NEW T,X,BUDZ,BUDG,%,E,G,Y,Z,BUDHEPA,BUDVS,TIEN,CTR,VIEN,VDATE
+2 SET T=$ORDER(^BUDHTSSC("B","T6B IMM CONTRA HEP A",0))
SET X=""
+3 SET BUDZ=0
FOR
SET BUDZ=$ORDER(^BUDHTSSC(T,15,"B",BUDZ))
IF BUDZ=""!(X]"")
QUIT
SET X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
+4 IF X]""
QUIT "1^HEP A: CONTRA IMM package "_$$DATE^BUDHUTL1($PIECE(X,U))_" "_$PIECE(X,U,2)
+5 KILL BUDG
SET %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BUDG(")
+6 SET T=$ORDER(^BUDHTSSC("B","T6B IMM CONTRA HEP A",0))
+7 SET X=0
SET G=""
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+8 SET Y=+$PIECE(BUDG(X),U,4)
+9 SET Z=$PIECE($GET(^AUPNVPOV(Y,0)),U,1)
+10 IF $DATA(^BUDHTSSC("AD",Z,T))
SET G="1^HEP A: CONTRA DX "_$PIECE(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
+11 SET S=$$VAL^XBDIQ1(9000010.07,Y,1101)
IF S]""
IF $DATA(^BUDHTSSC("AS",S,T))
SET G="1^HEP A: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
End DoDot:1
+12 IF G]""
QUIT G
+13 SET X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA HEP A",EDATE,0)
IF X
QUIT "1^HEP A CONTRA DX: "_$PIECE(X,U,2)_" on Problem List"
+14 SET X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$ORDER(^BUDHTSSC("B","T6B IMM HEP A CODES",0)),"HEP A")
+15 IF X]""
QUIT X
HEPAEVID ;
+1 ;any evidence of HEPA?
+2 KILL BUDG
SET %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BUDG(")
+3 SET T=$ORDER(^BUDHTSSC("B","T6B IMM EVIDENCE HEP A",0))
+4 SET X=0
SET G=""
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+5 SET Y=+$PIECE(BUDG(X),U,4)
+6 SET Z=$PIECE($GET(^AUPNVPOV(Y,0)),U,1)
+7 IF $DATA(^BUDHTSSC("AD",Z,T))
SET G="1^HEP A: Evidence "_$PIECE(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
QUIT
+8 SET S=$$VAL^XBDIQ1(9000010.07,Y,.01)
IF S]""
IF $DATA(^BUDHTSSC("AS",S,T))
SET G="1^HEP A: Evidence "_S_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
End DoDot:1
+9 IF G]""
QUIT G
+10 SET X=$$PLCL^BUDHDU(P,"T6B IMM EVIDENCE HEP A",EDATE,0)
IF X
QUIT "1^HEP A: Evidence: "_$PIECE(X,U,2)_" on Problem List"
HEPAI ;
+1 SET BUDHEPA=""
+2 ;all visits in 42 days to end
DO ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS")
+3 SET TIEN=$ORDER(^BUDHTSSC("B","T6B IMM HEP A CODES",0))
+4 SET CTR=0
FOR
SET CTR=$ORDER(BUDVS(CTR))
IF CTR'=+CTR
QUIT
Begin DoDot:1
+5 SET VIEN=$PIECE(BUDVS(CTR),U,5)
+6 SET VDATE=$PIECE(BUDVS(CTR),U,1)
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+8 IF '$DATA(^AUPNVIMM(X,0))
QUIT
+9 SET Y=$$VALI^XBDIQ1(9000010.11,X,.01)
+10 SET Y=+$PIECE($GET(^AUTTIMM(Y,0)),U,3)
+11 IF 'Y
QUIT
+12 IF $DATA(^BUDHTSSC(TIEN,15,"B",Y))
SET BUDHEPA="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+13 ;CPT
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+15 IF '$DATA(^AUPNVCPT(X,0))
QUIT
+16 SET Y=$$VAL^XBDIQ1(9000010.18,X,.01)
+17 IF Y=""
QUIT
+18 IF $DATA(^BUDHTSSC("AC",Y,TIEN))
SET BUDHEPA="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+19 ;V TRANS
+20 SET X=0
FOR
SET X=$ORDER(^AUPNVTC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+21 IF '$DATA(^AUPNVTC(X,0))
QUIT
+22 SET Y=$$VAL^XBDIQ1(9000010.33,X,.07)
+23 IF Y=""
QUIT
+24 IF $DATA(^BUDHTSSC("AC",Y,TIEN))
SET BUDHEPA="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+25 ;V PROC
+26 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+27 IF '$DATA(^AUPNVPRC(X,0))
QUIT
+28 SET Y=$$VALI^XBDIQ1(9000010.08,X,.01)
+29 IF $DATA(^BUDHTSSC("AP",Y,TIEN))
SET BUDHEPA="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+30 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+31 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+32 SET Y=$$VAL^XBDIQ1(9000010.07,X,1101)
+33 IF Y=""
QUIT
+34 IF $DATA(^BUDHTSSC("AS",Y,TIEN))
SET BUDHEPA="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
End DoDot:1
+35 IF BUDHEPA]""
QUIT "1^HEP A: "_BUDHEPA
+36 ;
+37 QUIT "0^1 HEP A"
+38 ;
FLU(P,BDATE,EDATE) ;EP
+1 NEW BUDD,BUDG,BUDX,T,X,Y,Z,BUDZ,G,S,BUDFLU,BUDVS,TIEN,CTR,VIEN,VDATE,C
+2 SET T=$ORDER(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0))
SET X=""
+3 SET BUDZ=0
FOR
SET BUDZ=$ORDER(^BUDHTSSC(T,15,"B",BUDZ))
IF BUDZ=""!(X]"")
QUIT
SET X=$$ROTACONT^BUDHRP6W(P,BUDZ,EDATE)
+4 IF X]""
QUIT "1^Influenza: CONTRA IMM package "_$$DATE^BUDHUTL1($PIECE(X,U))_" "_$PIECE(X,U,2)
+5 SET BUDZ=0
FOR
SET BUDZ=$ORDER(^BUDHTSSC(T,15,"B",BUDZ))
IF BUDZ=""!(X]"")
QUIT
SET X=$$EGGCONT^BUDHRP6C(P,BUDZ,EDATE)
+6 IF X]""
QUIT "1^Influenza: CONTRA IMM package "_$$DATE^BUDHUTL1($PIECE(X,U))_" "_$PIECE(X,U,2)
+7 SET T=$ORDER(^BUDHTSSC("B","T6B IMM CONTRA INFLUENZA",0))
+8 KILL BUDG
SET %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BUDG(")
+9 SET X=0
SET G=""
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Y=+$PIECE(BUDG(X),U,4)
+11 SET Z=$PIECE($GET(^AUPNVPOV(Y,0)),U,1)
+12 IF $DATA(^BUDHTSSC("AD",Z,T))
SET G="1^Influenza: CONTRA DX "_$PIECE(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
+13 SET S=$$VAL^XBDIQ1(9000010.07,Y,1101)
IF S]""
IF $DATA(^BUDHTSSC("AS",S,T))
SET G="1^Influenza: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
End DoDot:1
+14 IF G]""
QUIT G
+15 SET X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA INFLUENZA,EDATE,0")
IF X
QUIT "1^Influenza: CONTRA DX "_$PIECE(X,U,2)_" on Problem List"
+16 SET X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$ORDER(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0)),"INFLUENZA")
+17 IF X]""
QUIT X
+18 SET X=$$DIS^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"FLU: CONTRA DIS IMMUNE SYS"
+19 SET X=$$HIV^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"FLU: CONTRA HIV"
+20 SET X=$$MNLHT^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"FLU: CONTRA NEOPLASM"
+21 KILL BUDFLU
FLUIMM ;get all immunizations
+1 SET BUDFLU=0
+2 ;all visits in 42 days to end
DO ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS")
+3 SET TIEN=$ORDER(^BUDHTSSC("B","T6B IMM INFLUENZA CODES",0))
+4 SET CTR=0
FOR
SET CTR=$ORDER(BUDVS(CTR))
IF CTR'=+CTR
QUIT
Begin DoDot:1
+5 SET VIEN=$PIECE(BUDVS(CTR),U,5)
+6 SET VDATE=$PIECE(BUDVS(CTR),U,1)
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+8 IF '$DATA(^AUPNVIMM(X,0))
QUIT
+9 SET Y=$$VALI^XBDIQ1(9000010.11,X,.01)
+10 SET Y=+$PIECE($GET(^AUTTIMM(Y,0)),U,3)
+11 IF 'Y
QUIT
+12 IF $DATA(^BUDHTSSC(TIEN,15,"B",Y))
SET BUDFLU(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+13 ;CPT
+14 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+15 IF '$DATA(^AUPNVCPT(X,0))
QUIT
+16 SET Y=$$VAL^XBDIQ1(9000010.18,X,.01)
+17 IF Y=""
QUIT
+18 IF $DATA(^BUDHTSSC("AC",Y,TIEN))
SET BUDFLU(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+19 ;V TRANS
+20 SET X=0
FOR
SET X=$ORDER(^AUPNVTC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+21 IF '$DATA(^AUPNVTC(X,0))
QUIT
+22 SET Y=$$VAL^XBDIQ1(9000010.33,X,.07)
+23 IF Y=""
QUIT
+24 IF $DATA(^BUDHTSSC("AC",Y,TIEN))
SET BUDFLU(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+25 ;V PROC
+26 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+27 IF '$DATA(^AUPNVPRC(X,0))
QUIT
+28 SET Y=$$VALI^XBDIQ1(9000010.08,X,.01)
+29 IF $DATA(^BUDHTSSC("AP",Y,TIEN))
SET BUDFLU(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+30 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+31 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+32 SET Y=$$VAL^XBDIQ1(9000010.07,X,1101)
+33 IF Y=""
QUIT
+34 IF $DATA(^BUDHTSSC("AS",Y,TIEN))
SET BUDFLU(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
End DoDot:1
+35 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BUDFLU(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+36 IF C=1
SET Y=X
QUIT
+37 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BUDFLU(X)
QUIT
+38 SET Y=X
End DoDot:1
+39 ;now count them and see if there are 4 of them
+40 SET BUDFLU=0
SET X=0
FOR
SET X=$ORDER(BUDFLU(X))
IF X'=+X
QUIT
SET BUDFLU=BUDFLU+1
+41 IF BUDFLU>1
SET Y="1^Influenza: total #: "_BUDFLU
SET X=""
FOR
SET X=$ORDER(BUDFLU(X))
IF X'=+X
QUIT
SET Y=Y_" "_BUDFLU(X)
+42 IF BUDFLU>1
QUIT Y
+43 SET X=2-BUDFLU
+44 QUIT "0^"_X_" Influenza"
+45 ;
ROTA(P,BDATE,EDATE) ;EP
+1 NEW BUDD,BUDG,BUDX,T,BUDZ,X,Y,Z,G,%,E,BUDROT2,BUDROT3,BUDVS,TIEN2,TIEN3,CTR,VIEN,VDATE
+2 KILL BUDD,BUDG,BUDX
+3 SET T=$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0))
SET X=""
+4 SET BUDZ=0
FOR
SET BUDZ=$ORDER(^BUDHTSSC(T,15,"B",BUDZ))
IF BUDZ=""!(X]"")
QUIT
SET X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
+5 IF X]""
QUIT "1^Rotavirus: CONTRA IMM package "_$$DATE^BUDHUTL1($PIECE(X,U))_" "_$PIECE(X,U,2)
+6 SET T=$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0))
+7 SET BUDZ=0
FOR
SET BUDZ=$ORDER(^BUDHTSSC(T,15,"B",BUDZ))
IF BUDZ=""!(X]"")
QUIT
SET X=$$ANCONT^BUDHRP6C(P,BUDZ,EDATE)
+8 IF X]""
QUIT "1^Rotavirus: CONTRA IMM package "_$$DATE^BUDHUTL1($PIECE(X,U))_" "_$PIECE(X,U,2)
+9 KILL BUDG
SET %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BUDG(")
+10 SET T=$ORDER(^BUDHTSSC("B","T6B IMM CONTRA ROTAVIRUS",0))
+11 SET X=0
SET G=""
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+12 SET Y=+$PIECE(BUDG(X),U,4)
+13 SET Z=$PIECE($GET(^AUPNVPOV(Y,0)),U,1)
+14 IF $DATA(^BUDHTSSC("AD",Z,T))
SET G="1^Rotavirus: CONTRA DX "_$PIECE(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
+15 SET S=$$VAL^XBDIQ1(9000010.07,Y,1101)
IF S]""
IF $DATA(^BUDHTSSC("AS",S,T))
SET G="1^Rotavirus: CONTRA DX "_S_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
End DoDot:1
+16 IF G]""
QUIT G
+17 SET X=$$PLCL^BUDHDU(P,"T6B IMM CONTRA ROTAVIRUS",EDATE,0)
IF X
QUIT "1^Rotavirus: CONTRA DX "_$PIECE(X,U,2)_" on Problem List"
+18 SET X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0)),"ROTAVIRUS 2")
+19 IF X]""
QUIT X
+20 SET X=$$CONTRA^BUDHRP6C(P,$$DOB^AUPNPAT(P),EDATE,$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0)),"ROTAVIRUS 3")
+21 IF X]""
QUIT X
+22 SET X=$$ANSNROTA^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"ROTA: CONTRA ANAPHYLACTIC REACTION"
+23 SET X=$$SCID^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"ROTA: CONTRA SCID"
+24 SET X=$$INTUSS^BUDHUTL3(P,EDATE)
IF X
QUIT 1_U_"ROTA: CONTRA INTUSSUSCEPTION"
ROTAEVID ;
+1 ;any evidence of ROTA?
+2 KILL BUDG
SET %=P_"^ALL DX;DURING "_$$DOB^AUPNPAT(P)_"-"_EDATE
SET E=$$START1^APCLDF(%,"BUDG(")
+3 SET T=$ORDER(^BUDHTSSC("B","T6B IMM EVIDENCE ROTAVIRUS",0))
+4 SET X=0
SET G=""
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+5 SET Y=+$PIECE(BUDG(X),U,4)
+6 SET Z=$PIECE($GET(^AUPNVPOV(Y,0)),U,1)
+7 IF $DATA(^BUDHTSSC("AD",Z,T))
SET G="1^Rotavirus: Evidence "_$PIECE(BUDG(X),U,2)_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
QUIT
+8 SET S=$$VAL^XBDIQ1(9000010.07,Y,.01)
IF S]""
IF $DATA(^BUDHTSSC("AS",S,T))
SET G="1^Rotavirus: Evidence "_S_" on "_$$DATE^BUDHUTL1($PIECE(BUDG(X),U))
End DoDot:1
+9 IF G]""
QUIT G
+10 SET X=$$PLCL^BUDHDU(P,"T6B IMM EVIDENCE ROTAVIRUS",EDATE,0)
IF X
QUIT "1^Rotavirus: Evidence "_$PIECE(X,U,2)_" on Problem List"
ROTAIMM ;
+1 ;all visits in 42 days to end
DO ALLV^APCLAPIU(P,BDATE,EDATE,"BUDVS")
+2 SET TIEN2=$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 2 DOSE CODES",0))
+3 SET TIEN3=$ORDER(^BUDHTSSC("B","T6B IMM ROTAVIRUS 3 DOSE CODES",0))
+4 SET CTR=0
FOR
SET CTR=$ORDER(BUDVS(CTR))
IF CTR'=+CTR
QUIT
Begin DoDot:1
+5 SET VIEN=$PIECE(BUDVS(CTR),U,5)
+6 SET VDATE=$PIECE(BUDVS(CTR),U,1)
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVIMM("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+8 IF '$DATA(^AUPNVIMM(X,0))
QUIT
+9 SET Y=$$VALI^XBDIQ1(9000010.11,X,.01)
+10 SET Y=+$PIECE($GET(^AUTTIMM(Y,0)),U,3)
+11 IF 'Y
QUIT
+12 IF $DATA(^BUDHTSSC(TIEN2,15,"B",Y))
SET BUDROT2(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
+13 IF $DATA(^BUDHTSSC(TIEN3,15,"B",Y))
SET BUDROT3(VDATE)="CVX "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+14 ;CPT
+15 SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+16 IF '$DATA(^AUPNVCPT(X,0))
QUIT
+17 SET Y=$$VAL^XBDIQ1(9000010.18,X,.01)
+18 IF Y=""
QUIT
+19 IF $DATA(^BUDHTSSC("AC",Y,TIEN2))
SET BUDROT2(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
+20 IF $DATA(^BUDHTSSC("AC",Y,TIEN3))
SET BUDROT3(VDATE)="CPT "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+21 ;V TRANS
+22 SET X=0
FOR
SET X=$ORDER(^AUPNVTC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+23 IF '$DATA(^AUPNVTC(X,0))
QUIT
+24 SET Y=$$VAL^XBDIQ1(9000010.33,X,.07)
+25 IF Y=""
QUIT
+26 IF $DATA(^BUDHTSSC("AC",Y,TIEN2))
SET BUDROT2(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
+27 IF $DATA(^BUDHTSSC("AC",Y,TIEN3))
SET BUDROT3(VDATE)="CPT/TRAN "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+28 ;V PROC
+29 SET X=0
FOR
SET X=$ORDER(^AUPNVPRC("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+30 IF '$DATA(^AUPNVPRC(X,0))
QUIT
+31 SET Y=$$VALI^XBDIQ1(9000010.08,X,.01)
+32 IF $DATA(^BUDHTSSC("AP",Y,TIEN2))
SET BUDROT2(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
+33 IF $DATA(^BUDHTSSC("AP",Y,TIEN3))
SET BUDROT3(VDATE)="PROC "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
+34 ;V SNOM
+35 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",VIEN,X))
IF X'=+X
QUIT
Begin DoDot:2
+36 IF '$DATA(^AUPNVPOV(X,0))
QUIT
+37 SET Y=$$VAL^XBDIQ1(9000010.07,X,1101)
+38 IF Y=""
QUIT
+39 IF $DATA(^BUDHTSSC("AS",Y,TIEN2))
SET BUDROT2(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
+40 IF $DATA(^BUDHTSSC("AS",Y,TIEN3))
SET BUDROT3(VDATE)="SNOMED "_Y_" on "_$$DATE^BUDHUTL1(VDATE)
QUIT
End DoDot:2
End DoDot:1
+41 ;now check to see if they are all spaced 10 days apart, if not, kill off the odd ones
+42 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BUDROT2(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+43 IF C=1
SET Y=X
QUIT
+44 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BUDROT2(X)
QUIT
+45 SET Y=X
End DoDot:1
+46 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BUDROT3(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+47 IF C=1
SET Y=X
QUIT
+48 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BUDROT3(X)
QUIT
+49 SET Y=X
End DoDot:1
+50 ;now count them and see if there are 3 of them
+51 SET BUDROT2=0
SET X=0
FOR
SET X=$ORDER(BUDROT2(X))
IF X'=+X
QUIT
SET BUDROT2=BUDROT2+1
+52 IF BUDROT2>1
SET Y="1^Rotavirus 2 Dose: total #: "_BUDROT2
SET X=""
FOR
SET X=$ORDER(BUDROT2(X))
IF X'=+X
QUIT
SET Y=Y_" "_BUDROT2(X)
+53 IF BUDROT2>1
QUIT Y
+54 SET BUDROT3=0
SET X=0
FOR
SET X=$ORDER(BUDROT3(X))
IF X'=+X
QUIT
SET BUDROT3=BUDROT3+1
+55 IF BUDROT3>2
SET Y="1^Rotavirus 3 Dose: total #: "_BUDROT3
SET X=""
FOR
SET X=$ORDER(BUDROT3(X))
IF X'=+X
QUIT
SET Y=Y_" "_BUDROT3(X)
+56 IF BUDROT3>2
QUIT Y
+57 ;now see if has 3 total
+58 KILL BUDROTA
+59 SET X=0
FOR
SET X=$ORDER(BUDROT2(X))
IF X'=+X
QUIT
SET BUDROTA(X)=BUDROT2(X)
+60 SET X=0
FOR
SET X=$ORDER(BUDROT3(X))
IF X'=+X
QUIT
IF '$DATA(BUDROTA(X))
SET BUDROTA(X)=BUDROT3(X)
+61 ;see if 11 days apart
+62 SET (X,Y)=""
SET C=0
FOR
SET X=$ORDER(BUDROTA(X))
IF X'=+X
QUIT
SET C=C+1
Begin DoDot:1
+63 IF C=1
SET Y=X
QUIT
+64 IF $$FMDIFF^XLFDT(X,Y)<11
KILL BUDROTA(X)
QUIT
+65 SET Y=X
End DoDot:1
+66 SET BUDROTA=0
SET X=0
FOR
SET X=$ORDER(BUDROTA(X))
IF X'=+X
QUIT
SET BUDROTA=BUDROTA+1
+67 IF BUDROTA>2
SET Y="1^Rotavirus 3 Dose: total #: "_BUDROTA
SET X=""
FOR
SET X=$ORDER(BUDROTA(X))
IF X'=+X
QUIT
SET Y=Y_" "_BUDROTA(X)
+68 IF BUDROTA>2
QUIT Y
+69 QUIT "0^"_(2-BUDROT2)_" 2 Dose Rotavirus or "_(3-BUDROT3)_" 3 Dose Rotavirus"
+70 ;
