BUD2RP7A ; IHS/CMI/LAB - UDS REPORT PROCESSOR 01 Dec 2012 5:11 PM ;
;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
;;
PRGHLST ;EP - list of pregnant females
;is patient pregnant during the time period BUDBD and BUDED
Q:BUDSEX'="F"
S BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
I '$P(BUDP,U) Q ;not pregnant
S BUDHIV=$$HIV(DFN,BUDED)
I '$P(BUDHIV,U) Q ;no HIV
S BUDRACEX=$$RACE^BUD2RPTC(DFN),BUDRACE=$P(BUDRACEX,U,2),BUDRACEP=$P(BUDRACEX,U,5)
S BUDRACEE=$$RACE^BUD2RP7I(BUDRACE)
S BUDR=""
S BUDETHN=$P($$HISP^BUD2RPTC(DFN),U,1)
I +BUDETHN=1 S BUDETHNN="Hispanic or Latino"
I +BUDETHN=2 S BUDETHNN="Non-Hispanic/Latino"
I +BUDETHN=3 S BUDETHNN="Unreported/Refused to Report"
I BUDRACEP=8,(+BUDETHN=3) S BUDR=17 G SETSECTH ;BOTH BLANK OR REFUSED
I +BUDETHN=1 S BUDR=BUDRACEP G SETSECTH
I +BUDETHN=2!(+BUDETHN=3) S BUDR=BUDRACEP+8
SETSECTH ;
S $P(BUDSECTH(1),U,BUDR)=$P($G(BUDSECTH(1)),U,BUDR)+1
S $P(BUDSECTH(1),U,18)=$P($G(BUDSECTH(1)),U,18)+1
S ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGH",BUDAGEP,$P(^DPT(DFN,0),U),BUDCOM,DFN)=$P(BUDP,"*",2)_"#"_$P(BUDHIV,"*",2)
Q
;
PREG(P,BDATE,EDATE,NORXCHR) ;EP
NEW BUDDX,B,CNT,BUDD,BUDG,BUDALL,BUDA,BUDDX,C,X,V,D,G,Z,T,%
S B=0,CNT=0,BUDD="",BUDALL="" ;if there is one before time frame set this to 1
S NORXCHR=$G(NORXCHR)
K BUDG
S Y="BUDG("
S X=P_"^ALL DX [BGP GPRA PREGNANCY DIAGNOSES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
;now reorder by date of diagnosis and eliminate all chr and rx if necessary
;unduplicate by date
S X=0 F S X=$O(BUDG(X)) Q:X'=+X S BUDA($P(BUDG(X),U,1))=BUDG(X)
K BUDG
M BUDG=BUDA
K BUDA
S X=0 F S X=$O(BUDG(X)) Q:X'=+X D
.;get date
.S D=$P(BUDG(X),U,1)
.S C=$$CLINIC^APCLV($P(BUDG(X),U,5),"C")
.I NORXCHR,C=39 Q
.S C=$$PRIMPROV^APCLV($P(BUDG(X),U,5),"D")
.I NORXCHR,C=53 Q ;no chr as primary provider
.S V=$P(BUDG(X),U,5)
.S BUDDX(D)="",CNT=CNT+1,BUDALL=BUDALL_V_"|"_$P(BUDG(X),U,2)_U I CNT=2 S BUDD=D
.I D>$$FMADD^XLFDT(EDATE,-365) S B=1
.Q
I CNT>1,B G MA
I 'B Q 0 ;no visit during time period
PROB S T=$O(^ATXAX("B","BGP GPRA PREGNANCY DIAGNOSES",0))
S (X,G)=0,Z="" F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
.Q:$P(^AUPNPROB(X,0),U,12)'="A"
.Q:$P(^AUPNPROB(X,0),U,8)>EDATE
.Q:$P(^AUPNPROB(X,0),U,8)<BDATE
.S Y=$P(^AUPNPROB(X,0),U)
.Q:'$$ICD^ATXCHK(Y,T,9)
.S G=$P(^AUPNPROB(X,0),U,8),Z=X
.Q
I G=0,BUDD="" Q 0 ;no dxs and no problem list
S BUDD=G,BUDALL=BUDALL_"Problem List: "_$$VAL^XBDIQ1(9000011,Z,.01)_" on "_$$DATE^BUD2UTL1(G)
MA ;now check for abortion or miscarriage
;abortion first
K BUDG S Y="BUDG(" S X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_$$FMTE^XLFDT(BUDD)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
I $D(BUDG(1)) Q 0 ;HAD MIS/AB
S BUDG=$$LASTPRC^BUD2UTL1(P,"BGP ABORTION PROCEDURES",BDATE,EDATE)
I BUDG Q 0
S T=$O(^ATXAX("B","BGP MISCARRIAGE/ABORTION DXS",0))
S (X,G)=0 F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G) D
.Q:$P(^AUPNPROB(X,0),U,12)'="A"
.Q:$P(^AUPNPROB(X,0),U,8)<BUDD
.Q:$P(^AUPNPROB(X,0),U,8)>EDATE
.S Y=$P(^AUPNPROB(X,0),U)
.Q:'$$ICD^ATXCHK(Y,T,9)
.S G=1
.Q
I G Q 0
;now check CPTs for Abortion and Miscarriage
S T=$O(^ATXAX("B","BGP CPT ABORTION",0))
S %=$$CPT^BUD2DU(P,BUDD,EDATE,T,3)
I %]"" Q 0
S T=$O(^ATXAX("B","BGP CPT MISCARRIAGE",0))
S %=$$CPT^BUD2DU(P,BUDD,EDATE,T,3)
I %]"" Q 0
S T=$O(^ATXAX("B","BGP CPT ABORTION",0))
S %=$$TRAN^BUD2DU(P,BUDD,EDATE,T,3)
I %]"" Q 0
S T=$O(^ATXAX("B","BGP CPT MISCARRIAGE",0))
S %=$$TRAN^BUD2DU(P,BUDD,EDATE,T,3)
I %]"" Q 0
Q 1_"*"_BUDALL
;
HIV(P,EDATE) ;HIV DX OR PL? return date of most recent
NEW BDATE,BUDG,Y,X,E,T,G,C,S,D,BUDD,BUDA,GOT
S GOT=""
S Y="BUDG("
K BUDG
S BDATE=$P(^DPT(P,0),U,3) ;dob
S C=0,S=0,G=0 ;c is total count s is one during past 6 months, G is on problem list
;check problem list
S T=$O(^ATXAX("B","BGP HIV/AIDS DXS",0))
S X=0,G="" F S X=$O(^AUPNPROB("AC",P,X)) Q:X'=+X!(G]"") D
.Q:$P(^AUPNPROB(X,0),U,12)="D"
.Q:$P(^AUPNPROB(X,0),U,8)>EDATE
.S Y=$P(^AUPNPROB(X,0),U)
.Q:'$$ICD^ATXCHK(Y,T,9)
.S G=$P(^AUPNPROB(X,0),U,8),C=$$VAL^XBDIQ1(9000011,X,.01)
.Q
I G D Q Y
.S Y="1*"
.I G S Y=Y_"Problem List Diagnosis: "_C_" "_$$FMTE^XLFDT(G)_U
S Y="BUDG("
K BUDG
S X=P_"^ALL DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,Y)
;reorder and unduplicate by date
K BUDD S X=0 F S X=$O(BUDG(X)) Q:X'=+X S D=$P(BUDG(X),U,1),BUDD(D)=BUDG(X)
;now count and check for 1 in past 6 months
S Y=$$FMADD^XLFDT(EDATE,-180)
S D=0 F S D=$O(BUDD(D)) Q:D'=+D S C=C+1 I D'<Y S S=1
;I 'S Q "" ;no HIV dx in past 6 months
I C>1 S GOT=1
;.S Y="1*"
;.;S X=0 F S X=$O(BUDD(X)) Q:X'=+X S Y=Y_$P(BUDD(X),U,5)_"|"_$P(BUDD(X),U,2)_U
;.K BUDG,BUDD
;.S X=P_"^LAST DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BUDG(")
;.S Y=Y_"@"_$P(BUDG(1),U,2)_" "_$$FMTE^XLFDT($P(BUDG(1),U))
;K BUDD,BUDG
I G!(GOT) D Q Y
.S Y="1*"
.I G S Y=Y_"Problem List Diagnosis: "_C_" "_$$FMTE^XLFDT(G)_U
.S X=0 F S X=$O(BUDD(X)) Q:X<$$FMADD^XLFDT(EDATE,-365) S Y=Y_$P(BUDD(X),U,5)_"|"_$P(BUDD(X),U,2)_U
.S X=P_"^LAST DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BUDG(")
.S Y=Y_"@"_$P(BUDG(1),U,2)_" "_$$FMTE^XLFDT($P(BUDG(1),U))
Q ""
PRGRLST ;EP - list of pregnant females
;is patient pregnant during the time period BUDBD and BUDED
Q:BUDSEX'="F"
S BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
I '$P(BUDP,U) Q ;not pregnant
S BUDHISPN=$$HISP^BUD2RPTC(DFN)
S BUDHISP=$P($$HISP^BUD2RPTC(DFN),U,1) ;1=hispanic 2=non hispanic
;S BUDHISP1=BUDHISP+2 ;set piece
;
S BUDR1=$$RACE^BUD2RPTC(DFN)
S BUDR=$P(BUDR1,U,1) ;LINE
S ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGR",$P(BUDR1,U,5),BUDHISP,BUDCOM,BUDAGEP,$P(^DPT(DFN,0),U),DFN)=$P(BUDP,"*",2)
Q
;
PRGELST ;EP - list of pregnant females
;is patient pregnant during the time period BUDBD and BUDED
Q:BUDSEX'="F"
S BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
I '$P(BUDP,U) Q ;not pregnant
S BUDRACE=$$HISP^BUD2RPTC(DFN)
I +BUDRACE=1 S BUDRACE="Hispanic or Latino"
I +BUDRACE=2 S BUDRACE="All Others"
S ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGE",BUDRACE,BUDCOM,BUDAGEP,$P(^DPT(DFN,0),U),DFN)=$P(BUDP,"*",2)
Q
;
BUD2RP7A ; IHS/CMI/LAB - UDS REPORT PROCESSOR 01 Dec 2012 5:11 PM ;
+1 ;;10.0;IHS/RPMS UNIFORM DATA SYSTEM;;FEB 04, 2016;Build 50
+2 ;;
PRGHLST ;EP - list of pregnant females
+1 ;is patient pregnant during the time period BUDBD and BUDED
+2 IF BUDSEX'="F"
QUIT
+3 SET BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
+4 ;not pregnant
IF '$PIECE(BUDP,U)
QUIT
+5 SET BUDHIV=$$HIV(DFN,BUDED)
+6 ;no HIV
IF '$PIECE(BUDHIV,U)
QUIT
+7 SET BUDRACEX=$$RACE^BUD2RPTC(DFN)
SET BUDRACE=$PIECE(BUDRACEX,U,2)
SET BUDRACEP=$PIECE(BUDRACEX,U,5)
+8 SET BUDRACEE=$$RACE^BUD2RP7I(BUDRACE)
+9 SET BUDR=""
+10 SET BUDETHN=$PIECE($$HISP^BUD2RPTC(DFN),U,1)
+11 IF +BUDETHN=1
SET BUDETHNN="Hispanic or Latino"
+12 IF +BUDETHN=2
SET BUDETHNN="Non-Hispanic/Latino"
+13 IF +BUDETHN=3
SET BUDETHNN="Unreported/Refused to Report"
+14 ;BOTH BLANK OR REFUSED
IF BUDRACEP=8
IF (+BUDETHN=3)
SET BUDR=17
GOTO SETSECTH
+15 IF +BUDETHN=1
SET BUDR=BUDRACEP
GOTO SETSECTH
+16 IF +BUDETHN=2!(+BUDETHN=3)
SET BUDR=BUDRACEP+8
SETSECTH ;
+1 SET $PIECE(BUDSECTH(1),U,BUDR)=$PIECE($GET(BUDSECTH(1)),U,BUDR)+1
+2 SET $PIECE(BUDSECTH(1),U,18)=$PIECE($GET(BUDSECTH(1)),U,18)+1
+3 SET ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGH",BUDAGEP,$PIECE(^DPT(DFN,0),U),BUDCOM,DFN)=$PIECE(BUDP,"*",2)_"#"_$PIECE(BUDHIV,"*",2)
+4 QUIT
+5 ;
PREG(P,BDATE,EDATE,NORXCHR) ;EP
+1 NEW BUDDX,B,CNT,BUDD,BUDG,BUDALL,BUDA,BUDDX,C,X,V,D,G,Z,T,%
+2 ;if there is one before time frame set this to 1
SET B=0
SET CNT=0
SET BUDD=""
SET BUDALL=""
+3 SET NORXCHR=$GET(NORXCHR)
+4 KILL BUDG
+5 SET Y="BUDG("
+6 SET X=P_"^ALL DX [BGP GPRA PREGNANCY DIAGNOSES;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+7 ;now reorder by date of diagnosis and eliminate all chr and rx if necessary
+8 ;unduplicate by date
+9 SET X=0
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X
QUIT
SET BUDA($PIECE(BUDG(X),U,1))=BUDG(X)
+10 KILL BUDG
+11 MERGE BUDG=BUDA
+12 KILL BUDA
+13 SET X=0
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X
QUIT
Begin DoDot:1
+14 ;get date
+15 SET D=$PIECE(BUDG(X),U,1)
+16 SET C=$$CLINIC^APCLV($PIECE(BUDG(X),U,5),"C")
+17 IF NORXCHR
IF C=39
QUIT
+18 SET C=$$PRIMPROV^APCLV($PIECE(BUDG(X),U,5),"D")
+19 ;no chr as primary provider
IF NORXCHR
IF C=53
QUIT
+20 SET V=$PIECE(BUDG(X),U,5)
+21 SET BUDDX(D)=""
SET CNT=CNT+1
SET BUDALL=BUDALL_V_"|"_$PIECE(BUDG(X),U,2)_U
IF CNT=2
SET BUDD=D
+22 IF D>$$FMADD^XLFDT(EDATE,-365)
SET B=1
+23 QUIT
End DoDot:1
+24 IF CNT>1
IF B
GOTO MA
+25 ;no visit during time period
IF 'B
QUIT 0
PROB SET T=$ORDER(^ATXAX("B","BGP GPRA PREGNANCY DIAGNOSES",0))
+1 SET (X,G)=0
SET Z=""
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+2 IF $PIECE(^AUPNPROB(X,0),U,12)'="A"
QUIT
+3 IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+4 IF $PIECE(^AUPNPROB(X,0),U,8)<BDATE
QUIT
+5 SET Y=$PIECE(^AUPNPROB(X,0),U)
+6 IF '$$ICD^ATXCHK(Y,T,9)
QUIT
+7 SET G=$PIECE(^AUPNPROB(X,0),U,8)
SET Z=X
+8 QUIT
End DoDot:1
+9 ;no dxs and no problem list
IF G=0
IF BUDD=""
QUIT 0
+10 SET BUDD=G
SET BUDALL=BUDALL_"Problem List: "_$$VAL^XBDIQ1(9000011,Z,.01)_" on "_$$DATE^BUD2UTL1(G)
MA ;now check for abortion or miscarriage
+1 ;abortion first
+2 KILL BUDG
SET Y="BUDG("
SET X=P_"^LAST DX [BGP MISCARRIAGE/ABORTION DXS;DURING "_$$FMTE^XLFDT(BUDD)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+3 ;HAD MIS/AB
IF $DATA(BUDG(1))
QUIT 0
+4 SET BUDG=$$LASTPRC^BUD2UTL1(P,"BGP ABORTION PROCEDURES",BDATE,EDATE)
+5 IF BUDG
QUIT 0
+6 SET T=$ORDER(^ATXAX("B","BGP MISCARRIAGE/ABORTION DXS",0))
+7 SET (X,G)=0
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G)
QUIT
Begin DoDot:1
+8 IF $PIECE(^AUPNPROB(X,0),U,12)'="A"
QUIT
+9 IF $PIECE(^AUPNPROB(X,0),U,8)<BUDD
QUIT
+10 IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+11 SET Y=$PIECE(^AUPNPROB(X,0),U)
+12 IF '$$ICD^ATXCHK(Y,T,9)
QUIT
+13 SET G=1
+14 QUIT
End DoDot:1
+15 IF G
QUIT 0
+16 ;now check CPTs for Abortion and Miscarriage
+17 SET T=$ORDER(^ATXAX("B","BGP CPT ABORTION",0))
+18 SET %=$$CPT^BUD2DU(P,BUDD,EDATE,T,3)
+19 IF %]""
QUIT 0
+20 SET T=$ORDER(^ATXAX("B","BGP CPT MISCARRIAGE",0))
+21 SET %=$$CPT^BUD2DU(P,BUDD,EDATE,T,3)
+22 IF %]""
QUIT 0
+23 SET T=$ORDER(^ATXAX("B","BGP CPT ABORTION",0))
+24 SET %=$$TRAN^BUD2DU(P,BUDD,EDATE,T,3)
+25 IF %]""
QUIT 0
+26 SET T=$ORDER(^ATXAX("B","BGP CPT MISCARRIAGE",0))
+27 SET %=$$TRAN^BUD2DU(P,BUDD,EDATE,T,3)
+28 IF %]""
QUIT 0
+29 QUIT 1_"*"_BUDALL
+30 ;
HIV(P,EDATE) ;HIV DX OR PL? return date of most recent
+1 NEW BDATE,BUDG,Y,X,E,T,G,C,S,D,BUDD,BUDA,GOT
+2 SET GOT=""
+3 SET Y="BUDG("
+4 KILL BUDG
+5 ;dob
SET BDATE=$PIECE(^DPT(P,0),U,3)
+6 ;c is total count s is one during past 6 months, G is on problem list
SET C=0
SET S=0
SET G=0
+7 ;check problem list
+8 SET T=$ORDER(^ATXAX("B","BGP HIV/AIDS DXS",0))
+9 SET X=0
SET G=""
FOR
SET X=$ORDER(^AUPNPROB("AC",P,X))
IF X'=+X!(G]"")
QUIT
Begin DoDot:1
+10 IF $PIECE(^AUPNPROB(X,0),U,12)="D"
QUIT
+11 IF $PIECE(^AUPNPROB(X,0),U,8)>EDATE
QUIT
+12 SET Y=$PIECE(^AUPNPROB(X,0),U)
+13 IF '$$ICD^ATXCHK(Y,T,9)
QUIT
+14 SET G=$PIECE(^AUPNPROB(X,0),U,8)
SET C=$$VAL^XBDIQ1(9000011,X,.01)
+15 QUIT
End DoDot:1
+16 IF G
Begin DoDot:1
+17 SET Y="1*"
+18 IF G
SET Y=Y_"Problem List Diagnosis: "_C_" "_$$FMTE^XLFDT(G)_U
End DoDot:1
QUIT Y
+19 SET Y="BUDG("
+20 KILL BUDG
+21 SET X=P_"^ALL DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,Y)
+22 ;reorder and unduplicate by date
+23 KILL BUDD
SET X=0
FOR
SET X=$ORDER(BUDG(X))
IF X'=+X
QUIT
SET D=$PIECE(BUDG(X),U,1)
SET BUDD(D)=BUDG(X)
+24 ;now count and check for 1 in past 6 months
+25 SET Y=$$FMADD^XLFDT(EDATE,-180)
+26 SET D=0
FOR
SET D=$ORDER(BUDD(D))
IF D'=+D
QUIT
SET C=C+1
IF D'<Y
SET S=1
+27 ;I 'S Q "" ;no HIV dx in past 6 months
+28 IF C>1
SET GOT=1
+29 ;.S Y="1*"
+30 ;.;S X=0 F S X=$O(BUDD(X)) Q:X'=+X S Y=Y_$P(BUDD(X),U,5)_"|"_$P(BUDD(X),U,2)_U
+31 ;.K BUDG,BUDD
+32 ;.S X=P_"^LAST DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE) S E=$$START1^APCLDF(X,"BUDG(")
+33 ;.S Y=Y_"@"_$P(BUDG(1),U,2)_" "_$$FMTE^XLFDT($P(BUDG(1),U))
+34 ;K BUDD,BUDG
+35 IF G!(GOT)
Begin DoDot:1
+36 SET Y="1*"
+37 IF G
SET Y=Y_"Problem List Diagnosis: "_C_" "_$$FMTE^XLFDT(G)_U
+38 SET X=0
FOR
SET X=$ORDER(BUDD(X))
IF X<$$FMADD^XLFDT(EDATE,-365)
QUIT
SET Y=Y_$PIECE(BUDD(X),U,5)_"|"_$PIECE(BUDD(X),U,2)_U
+39 SET X=P_"^LAST DX [BGP HIV/AIDS DXS;DURING "_$$FMTE^XLFDT(BDATE)_"-"_$$FMTE^XLFDT(EDATE)
SET E=$$START1^APCLDF(X,"BUDG(")
+40 SET Y=Y_"@"_$PIECE(BUDG(1),U,2)_" "_$$FMTE^XLFDT($PIECE(BUDG(1),U))
End DoDot:1
QUIT Y
+41 QUIT ""
PRGRLST ;EP - list of pregnant females
+1 ;is patient pregnant during the time period BUDBD and BUDED
+2 IF BUDSEX'="F"
QUIT
+3 SET BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
+4 ;not pregnant
IF '$PIECE(BUDP,U)
QUIT
+5 SET BUDHISPN=$$HISP^BUD2RPTC(DFN)
+6 ;1=hispanic 2=non hispanic
SET BUDHISP=$PIECE($$HISP^BUD2RPTC(DFN),U,1)
+7 ;S BUDHISP1=BUDHISP+2 ;set piece
+8 ;
+9 SET BUDR1=$$RACE^BUD2RPTC(DFN)
+10 ;LINE
SET BUDR=$PIECE(BUDR1,U,1)
+11 SET ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGR",$PIECE(BUDR1,U,5),BUDHISP,BUDCOM,BUDAGEP,$PIECE(^DPT(DFN,0),U),DFN)=$PIECE(BUDP,"*",2)
+12 QUIT
+13 ;
PRGELST ;EP - list of pregnant females
+1 ;is patient pregnant during the time period BUDBD and BUDED
+2 IF BUDSEX'="F"
QUIT
+3 SET BUDP=$$PREG(DFN,$$FMADD^XLFDT(BUDED,-609),BUDED)
+4 ;not pregnant
IF '$PIECE(BUDP,U)
QUIT
+5 SET BUDRACE=$$HISP^BUD2RPTC(DFN)
+6 IF +BUDRACE=1
SET BUDRACE="Hispanic or Latino"
+7 IF +BUDRACE=2
SET BUDRACE="All Others"
+8 SET ^XTMP("BUD2RP7",BUDJ,BUDH,"PRGE",BUDRACE,BUDCOM,BUDAGEP,$PIECE(^DPT(DFN,0),U),DFN)=$PIECE(BUDP,"*",2)
+9 QUIT
+10 ;
