BUD0RPC2 ; IHS/CMI/LAB - UDS TABLE 6 11 Dec 2007 12:15 PM ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;
;
L27(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A=9110 S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z="D9110" S G=Z
.Q
Q G
L26B(BUDV) ;EP
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z=99408!(Z=99409) S G=Z
.Q
I G]"" Q G
S X=0 F S X=$O(^AUPNVPED("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$P($G(^AUPNVPED(X,0)),U)
.Q:Z=""
.Q:'$D(^AUTTEDT(Z,0))
.S Z=$P(^AUTTEDT(Z,0),U,2)
.I Z="AOD-INJ" S G=Z
Q G
L26C(BUDV) ;EP
;I $$CLINIC^APCLV(BUDV,"C")=94 Q "CLINIC 94"
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z=99406!(Z=99407)!(Z="S9075") S G=Z
.Q
I G]"" Q G
S X=0 F S X=$O(^AUPNVPED("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$P($G(^AUPNVPED(X,0)),U)
.Q:Z=""
.Q:'$D(^AUTTEDT(Z,0))
.S Z=$P(^AUTTEDT(Z,0),U,2)
.I $P(Z,"-",1)="TO" S G=Z Q
.I $P(Z,"-",2)="TO" S G=Z Q
.I $P(Z,"-",2)="SHS" S G=Z Q
I G]"" Q G
S X=0 F S X=$O(^AUPNVPOV("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.07,X,.01)
.I Z="305.1" S G="305.1"
Q G
L28(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A="0150"!(A="0120")!(A="0140")!(A="0160")!(A="0170")!(A="0180")!(A="0145") S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z="D0150"!(Z="D0120")!(Z="D0140")!(Z="D0160")!(Z="D0170")!(Z="D0180")!(Z="D0145") S G=Z
.Q
Q G
L29(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A=1110!(A=1120) S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z="D1110"!(Z="D1120") S G=Z
.Q
Q G
L30(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A=1351 S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z="D1351" S G=Z
.Q
Q G
L31(BUDV) ;EP
S G=""
;I '$D(^AUPNVDEN("AD",BUDV)) G L31POV
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A=1203!(A=1204)!(A=1206) S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z="D1203"!(Z="D1204")!(Z="D1206") S G=Z
.Q
Q G
L31POV ;EP
S G=""
S V=0 F S V=$O(^AUPNVPOV("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVPOV(V,0)),U)
.Q:'A
.S A=$P($$ICDDX^ICDCODE(A),U,2)
.I A="V07.31" S G=A
.Q
Q G
L32(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I $E(A,1,2)=21!($E(A,1,2)=22)!($E(A,1,2)=23)!($E(A,1,2)=24)!($E(A,1,2)=25)!($E(A,1,2)=26)!($E(A,1,2)=27)!($E(A,1,2)=28)!($E(A,1,2)=29) S G=A
.Q
I G]"" Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I $E(Z,1,3)="D21"!($E(Z,1,3)="D22")!($E(Z,1,3)="D23")!($E(Z,1,3)="D24")!($E(Z,1,3)="D25")!($E(Z,1,3)="D26")!($E(Z,1,3)="D27")!($E(Z,1,3)="D28")!($E(Z,1,3)="D29") S G=Z
.Q
Q G
L33(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I A=7111!(A=7140)!(A=7210)!(A=7220)!(A=7230)!(A=7240)!(A=7241)!(A=7250)!(A=7260)!(A=7261)!(A=7270)!(A=7272)!(A=7280) S G=A
.Q
I G]"" Q G
S V=0,G="" F S V=$O(^AUPNVCPT("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$$VAL^XBDIQ1(9000010.18,V,.01)
.I A="D7111"!(A="D7140")!(A="D7210")!(A="D7220")!(A="D7230")!(A="D7240")!(A="D7241")!(A="D7250")!(A="D7260")!(A="D7261")!(A="D7270")!(A="D7272")!(A="D7280") S G=A
.Q
Q G
L34(BUDV) ;EP
S V=0,G="" F S V=$O(^AUPNVDEN("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$P($G(^AUPNVDEN(V,0)),U)
.Q:'A
.S A=$P($G(^AUTTADA(A,0)),U)
.Q:A=""
.I $E(A)=3!($E(A)=4)!($E(A)=5)!($E(A)=6)!($E(A)=8) S G=A
.Q
I G]"" Q G
S V=0,G="" F S V=$O(^AUPNVCPT("AD",BUDV,V)) Q:V'=+V!(G]"") D
.S A=$$VAL^XBDIQ1(9000010.18,V,.01)
.I $E(A,1,2)="D3"!($E(A,1,2)="D4")!($E(A,1,2)="D5")!($E(A,1,2)="D6")!($E(A,1,2)="D8") S G=A
.Q
Q G
L26(BUDV) ;EP
I $$AGE^AUPNPAT($P(^AUPNVSIT(BUDV,0),U,5),BUDCAD)>11 Q ""
I $$CLINIC^APCLV(BUDV,"C")=24 Q "CLIN 24"
I $$CLINIC^APCLV(BUDV,"C")=57 Q "CLIN 57"
;S X=0,G="" F S X=$O(^AUPNVPOV("AD",BUDV,X)) Q:X'=+X!(G]"") S R=$P(^AUPNVPOV(X,0),U),R=$P($$ICDDX^ICDCODE(R),U,2) I $E(R,1,3)="V20"!($E(R,1,3)="V29") S G="V POV: "_R
;I G]"" Q G
S G="" I T S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$P(^AUPNVCPT(X,0),U),Z=$P($$CPT^ICPTCOD(Z),U,2)
.I Z=99391!(Z=99392)!(Z=99393)!(Z=99381)!(Z=99382)!(Z=99383) S G=Z Q
.;I Z=99431!(Z=99432)!(Z=99433) S G=Z Q
.Q
Q G
L26A(BUDV) ;EP
;age 9-72 months
S G=""
S A=$$AGE^BUD0UTL2(DFN,2,$$VD^APCLV(BUDV))
I A<9 Q G
I A>72 Q G
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z=83655 S G=Z
.Q
Q G
L26D(BUDV) ;EP
S G=""
S G="" S X=0 F S X=$O(^AUPNVCPT("AD",BUDV,X)) Q:X'=+X!(G]"") D
.S Z=$$VAL^XBDIQ1(9000010.18,X,.01)
.I Z=92002!(Z=92004)!(Z=92012)!(Z=92014) S G=Z
.Q
Q G
BUD0RPC2 ; IHS/CMI/LAB - UDS TABLE 6 11 Dec 2007 12:15 PM ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;
+3 ;
L27(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF A=9110
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+11 IF Z="D9110"
SET G=Z
+12 QUIT
End DoDot:1
+13 QUIT G
L26B(BUDV) ;EP
+1 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+2 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+3 IF Z=99408!(Z=99409)
SET G=Z
+4 QUIT
End DoDot:1
+5 IF G]""
QUIT G
+6 SET X=0
FOR
SET X=$ORDER(^AUPNVPED("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+7 SET Z=$PIECE($GET(^AUPNVPED(X,0)),U)
+8 IF Z=""
QUIT
+9 IF '$DATA(^AUTTEDT(Z,0))
QUIT
+10 SET Z=$PIECE(^AUTTEDT(Z,0),U,2)
+11 IF Z="AOD-INJ"
SET G=Z
End DoDot:1
+12 QUIT G
L26C(BUDV) ;EP
+1 ;I $$CLINIC^APCLV(BUDV,"C")=94 Q "CLINIC 94"
+2 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+3 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+4 IF Z=99406!(Z=99407)!(Z="S9075")
SET G=Z
+5 QUIT
End DoDot:1
+6 IF G]""
QUIT G
+7 SET X=0
FOR
SET X=$ORDER(^AUPNVPED("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+8 SET Z=$PIECE($GET(^AUPNVPED(X,0)),U)
+9 IF Z=""
QUIT
+10 IF '$DATA(^AUTTEDT(Z,0))
QUIT
+11 SET Z=$PIECE(^AUTTEDT(Z,0),U,2)
+12 IF $PIECE(Z,"-",1)="TO"
SET G=Z
QUIT
+13 IF $PIECE(Z,"-",2)="TO"
SET G=Z
QUIT
+14 IF $PIECE(Z,"-",2)="SHS"
SET G=Z
QUIT
End DoDot:1
+15 IF G]""
QUIT G
+16 SET X=0
FOR
SET X=$ORDER(^AUPNVPOV("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+17 SET Z=$$VAL^XBDIQ1(9000010.07,X,.01)
+18 IF Z="305.1"
SET G="305.1"
End DoDot:1
+19 QUIT G
L28(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF A="0150"!(A="0120")!(A="0140")!(A="0160")!(A="0170")!(A="0180")!(A="0145")
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+11 IF Z="D0150"!(Z="D0120")!(Z="D0140")!(Z="D0160")!(Z="D0170")!(Z="D0180")!(Z="D0145")
SET G=Z
+12 QUIT
End DoDot:1
+13 QUIT G
L29(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF A=1110!(A=1120)
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+11 IF Z="D1110"!(Z="D1120")
SET G=Z
+12 QUIT
End DoDot:1
+13 QUIT G
L30(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF A=1351
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+11 IF Z="D1351"
SET G=Z
+12 QUIT
End DoDot:1
+13 QUIT G
L31(BUDV) ;EP
+1 SET G=""
+2 ;I '$D(^AUPNVDEN("AD",BUDV)) G L31POV
+3 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+4 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+5 IF 'A
QUIT
+6 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+7 IF A=""
QUIT
+8 IF A=1203!(A=1204)!(A=1206)
SET G=A
+9 QUIT
End DoDot:1
+10 IF G]""
QUIT G
+11 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+12 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+13 IF Z="D1203"!(Z="D1204")!(Z="D1206")
SET G=Z
+14 QUIT
End DoDot:1
+15 QUIT G
L31POV ;EP
+1 SET G=""
+2 SET V=0
FOR
SET V=$ORDER(^AUPNVPOV("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+3 SET A=$PIECE($GET(^AUPNVPOV(V,0)),U)
+4 IF 'A
QUIT
+5 SET A=$PIECE($$ICDDX^ICDCODE(A),U,2)
+6 IF A="V07.31"
SET G=A
+7 QUIT
End DoDot:1
+8 QUIT G
L32(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF $EXTRACT(A,1,2)=21!($EXTRACT(A,1,2)=22)!($EXTRACT(A,1,2)=23)!($EXTRACT(A,1,2)=24)!($EXTRACT(A,1,2)=25)!($EXTRACT(A,1,2)=26)!($EXTRACT(A,1,2)=27)!($EXTRACT(A,1,2)=28)!($EXTRACT(A,1,2)=29)
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+11 IF $EXTRACT(Z,1,3)="D21"!($EXTRACT(Z,1,3)="D22")!($EXTRACT(Z,1,3)="D23")!($EXTRACT(Z,1,3)="D24")!($EXTRACT(Z,1,3)="D25")!($EXTRACT(Z,1,3)="D26")!($EXTRACT(Z,1,3)="D27")!($EXTRACT(Z,1,3)="D28")!($EXTRACT(Z,1,3)="D29")
SET G=Z
+12 QUIT
End DoDot:1
+13 QUIT G
L33(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF A=7111!(A=7140)!(A=7210)!(A=7220)!(A=7230)!(A=7240)!(A=7241)!(A=7250)!(A=7260)!(A=7261)!(A=7270)!(A=7272)!(A=7280)
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVCPT("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+10 SET A=$$VAL^XBDIQ1(9000010.18,V,.01)
+11 IF A="D7111"!(A="D7140")!(A="D7210")!(A="D7220")!(A="D7230")!(A="D7240")!(A="D7241")!(A="D7250")!(A="D7260")!(A="D7261")!(A="D7270")!(A="D7272")!(A="D7280")
SET G=A
+12 QUIT
End DoDot:1
+13 QUIT G
L34(BUDV) ;EP
+1 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVDEN("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+2 SET A=$PIECE($GET(^AUPNVDEN(V,0)),U)
+3 IF 'A
QUIT
+4 SET A=$PIECE($GET(^AUTTADA(A,0)),U)
+5 IF A=""
QUIT
+6 IF $EXTRACT(A)=3!($EXTRACT(A)=4)!($EXTRACT(A)=5)!($EXTRACT(A)=6)!($EXTRACT(A)=8)
SET G=A
+7 QUIT
End DoDot:1
+8 IF G]""
QUIT G
+9 SET V=0
SET G=""
FOR
SET V=$ORDER(^AUPNVCPT("AD",BUDV,V))
IF V'=+V!(G]"")
QUIT
Begin DoDot:1
+10 SET A=$$VAL^XBDIQ1(9000010.18,V,.01)
+11 IF $EXTRACT(A,1,2)="D3"!($EXTRACT(A,1,2)="D4")!($EXTRACT(A,1,2)="D5")!($EXTRACT(A,1,2)="D6")!($EXTRACT(A,1,2)="D8")
SET G=A
+12 QUIT
End DoDot:1
+13 QUIT G
L26(BUDV) ;EP
+1 IF $$AGE^AUPNPAT($PIECE(^AUPNVSIT(BUDV,0),U,5),BUDCAD)>11
QUIT ""
+2 IF $$CLINIC^APCLV(BUDV,"C")=24
QUIT "CLIN 24"
+3 IF $$CLINIC^APCLV(BUDV,"C")=57
QUIT "CLIN 57"
+4 ;S X=0,G="" F S X=$O(^AUPNVPOV("AD",BUDV,X)) Q:X'=+X!(G]"") S R=$P(^AUPNVPOV(X,0),U),R=$P($$ICDDX^ICDCODE(R),U,2) I $E(R,1,3)="V20"!($E(R,1,3)="V29") S G="V POV: "_R
+5 ;I G]"" Q G
+6 SET G=""
IF T
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+7 SET Z=$PIECE(^AUPNVCPT(X,0),U)
SET Z=$PIECE($$CPT^ICPTCOD(Z),U,2)
+8 IF Z=99391!(Z=99392)!(Z=99393)!(Z=99381)!(Z=99382)!(Z=99383)
SET G=Z
QUIT
+9 ;I Z=99431!(Z=99432)!(Z=99433) S G=Z Q
+10 QUIT
End DoDot:1
+11 QUIT G
L26A(BUDV) ;EP
+1 ;age 9-72 months
+2 SET G=""
+3 SET A=$$AGE^BUD0UTL2(DFN,2,$$VD^APCLV(BUDV))
+4 IF A<9
QUIT G
+5 IF A>72
QUIT G
+6 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+7 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+8 IF Z=83655
SET G=Z
+9 QUIT
End DoDot:1
+10 QUIT G
L26D(BUDV) ;EP
+1 SET G=""
+2 SET G=""
SET X=0
FOR
SET X=$ORDER(^AUPNVCPT("AD",BUDV,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+3 SET Z=$$VAL^XBDIQ1(9000010.18,X,.01)
+4 IF Z=92002!(Z=92004)!(Z=92012)!(Z=92014)
SET G=Z
+5 QUIT
End DoDot:1
+6 QUIT G
